1.1 --- a/Admin/Benchmarks/HOL-datatype/ROOT.ML Fri Feb 11 18:51:00 2005 +0100
1.2 +++ b/Admin/Benchmarks/HOL-datatype/ROOT.ML Sun Feb 13 17:15:14 2005 +0100
1.3 @@ -1,7 +1,7 @@
1.4 (* Title: Admin/Benchmarks/HOL-datatype/ROOT.ML
1.5 ID: $Id$
1.6
1.7 -Some rather large datatype examples (from John Harrison).
1.8 +SOME rather large datatype examples (from John Harrison).
1.9 *)
1.10
1.11 val tests = ["Brackin", "Instructions", "SML", "Verilog"];
2.1 --- a/NEWS Fri Feb 11 18:51:00 2005 +0100
2.2 +++ b/NEWS Sun Feb 13 17:15:14 2005 +0100
2.3 @@ -6,6 +6,11 @@
2.4
2.5 *** General ***
2.6
2.7 +* The type Library.option is no more, along with the exception
2.8 + Library.OPTION: Isabelle now uses the standard option type. The
2.9 + functions the, is_some, is_none, etc. are still in Library, but
2.10 + the constructors are now SOME and NONE instead of Some and None.
2.11 +
2.12 * Document preparation: new antiquotations @{lhs thm} and @{rhs thm}
2.13 printing the lhs/rhs of definitions, equations, inequations etc.
2.14
3.1 --- a/TFL/casesplit.ML Fri Feb 11 18:51:00 2005 +0100
3.2 +++ b/TFL/casesplit.ML Sun Feb 13 17:15:14 2005 +0100
3.3 @@ -72,11 +72,11 @@
3.4
3.5 (* finding a free var to split *)
3.6 val find_term_split :
3.7 - Term.term * Term.term -> (string * Term.typ) Library.option
3.8 + Term.term * Term.term -> (string * Term.typ) option
3.9 val find_thm_split :
3.10 - Thm.thm -> int -> Thm.thm -> (string * Term.typ) Library.option
3.11 + Thm.thm -> int -> Thm.thm -> (string * Term.typ) option
3.12 val find_thms_split :
3.13 - Thm.thm list -> int -> Thm.thm -> (string * Term.typ) Library.option
3.14 + Thm.thm list -> int -> Thm.thm -> (string * Term.typ) option
3.15
3.16 (* try to recursively split conjectured thm to given list of thms *)
3.17 val splitto : Thm.thm list -> Thm.thm -> Thm.thm
3.18 @@ -129,8 +129,8 @@
3.19 | TVar((s,i),_) => raise ERROR_MESSAGE
3.20 ("Free variable: " ^ s)
3.21 val dt = case (Symtab.lookup (dtypestab,ty_str))
3.22 - of Some dt => dt
3.23 - | None => raise ERROR_MESSAGE ("Not a Datatype: " ^ ty_str)
3.24 + of SOME dt => dt
3.25 + | NONE => raise ERROR_MESSAGE ("Not a Datatype: " ^ ty_str)
3.26 in
3.27 cases_thm_of_induct_thm (#induction dt)
3.28 end;
3.29 @@ -206,11 +206,11 @@
3.30 fun getter x =
3.31 let val (n,ty) = Term.dest_Free x in
3.32 (if vstr = n orelse vstr = Syntax.dest_skolem n
3.33 - then Some (n,ty) else None )
3.34 - handle LIST _ => None
3.35 + then SOME (n,ty) else NONE )
3.36 + handle LIST _ => NONE
3.37 end;
3.38 val (n,ty) = case Library.get_first getter freets
3.39 - of Some (n, ty) => (n, ty)
3.40 + of SOME (n, ty) => (n, ty)
3.41 | _ => raise ERROR_MESSAGE ("no such variable " ^ vstr);
3.42 val sgn = Thm.sign_of_thm th;
3.43
3.44 @@ -247,22 +247,22 @@
3.45 subterm, or constant in another, ie assume that one term is a plit of
3.46 another, then gives back the free variable that has been split. *)
3.47 exception find_split_exp of string
3.48 -fun find_term_split (Free v, _ $ _) = Some v
3.49 - | find_term_split (Free v, Const _) = Some v
3.50 - | find_term_split (Free v, Abs _) = Some v (* do we really want this case? *)
3.51 - | find_term_split (Free v, Var _) = None (* keep searching *)
3.52 +fun find_term_split (Free v, _ $ _) = SOME v
3.53 + | find_term_split (Free v, Const _) = SOME v
3.54 + | find_term_split (Free v, Abs _) = SOME v (* do we really want this case? *)
3.55 + | find_term_split (Free v, Var _) = NONE (* keep searching *)
3.56 | find_term_split (a $ b, a2 $ b2) =
3.57 (case find_term_split (a, a2) of
3.58 - None => find_term_split (b,b2)
3.59 + NONE => find_term_split (b,b2)
3.60 | vopt => vopt)
3.61 | find_term_split (Abs(_,ty,t1), Abs(_,ty2,t2)) =
3.62 find_term_split (t1, t2)
3.63 | find_term_split (Const (x,ty), Const(x2,ty2)) =
3.64 - if x = x2 then None else (* keep searching *)
3.65 + if x = x2 then NONE else (* keep searching *)
3.66 raise find_split_exp (* stop now *)
3.67 "Terms are not identical upto a free varaible! (Consts)"
3.68 | find_term_split (Bound i, Bound j) =
3.69 - if i = j then None else (* keep searching *)
3.70 + if i = j then NONE else (* keep searching *)
3.71 raise find_split_exp (* stop now *)
3.72 "Terms are not identical upto a free varaible! (Bound)"
3.73 | find_term_split (a, b) =
3.74 @@ -274,7 +274,7 @@
3.75 splitth. *)
3.76 fun find_thm_split splitth i genth =
3.77 find_term_split (Logic.get_goal (Thm.prop_of genth) i,
3.78 - Thm.concl_of splitth) handle find_split_exp _ => None;
3.79 + Thm.concl_of splitth) handle find_split_exp _ => NONE;
3.80
3.81 (* as above but searches "splitths" for a theorem that suggest a case split *)
3.82 fun find_thms_split splitths i genth =
3.83 @@ -304,12 +304,12 @@
3.84
3.85 fun split th =
3.86 (case find_thms_split splitths 1 th of
3.87 - None =>
3.88 + NONE =>
3.89 (writeln "th:";
3.90 Display.print_thm th; writeln "split ths:";
3.91 Display.print_thms splitths; writeln "\n--";
3.92 raise ERROR_MESSAGE "splitto: cannot find variable to split on")
3.93 - | Some v =>
3.94 + | SOME v =>
3.95 let
3.96 val gt = Data.dest_Trueprop (nth_elem(0, Thm.prems_of th));
3.97 val split_thm = mk_casesplit_goal_thm sgn v gt;
3.98 @@ -322,8 +322,8 @@
3.99 (* note: multiple unifiers! we only take the first element,
3.100 probably fine -- there is probably only one anyway. *)
3.101 (case Library.get_first (Seq.pull o solve_by_splitth th) splitths of
3.102 - None => split th
3.103 - | Some (solved_th, more) => solved_th)
3.104 + NONE => split th
3.105 + | SOME (solved_th, more) => solved_th)
3.106 in
3.107 recsplitf genth
3.108 end;
3.109 @@ -340,7 +340,7 @@
3.110 the well-foundness conditions have been solved. *)
3.111 local
3.112 fun get_related_thms i =
3.113 - mapfilter ((fn (r,x) => if x = i then Some r else None));
3.114 + mapfilter ((fn (r,x) => if x = i then SOME r else NONE));
3.115
3.116 fun solve_eq (th, [], i) =
3.117 raise ERROR_MESSAGE "derive_init_eqs: missing rules"
4.1 --- a/TFL/dcterm.ML Fri Feb 11 18:51:00 2005 +0100
4.2 +++ b/TFL/dcterm.ML Sun Feb 13 17:15:14 2005 +0100
4.3 @@ -71,7 +71,7 @@
4.4
4.5
4.6 (*---------------------------------------------------------------------------
4.7 - * Some simple constructor functions.
4.8 + * SOME simple constructor functions.
4.9 *---------------------------------------------------------------------------*)
4.10
4.11 val mk_hol_const = Thm.cterm_of (Theory.sign_of HOL.thy) o Const;
4.12 @@ -124,7 +124,7 @@
4.13 in (dest_monop expected M, N) handle U.ERR _ => err () end;
4.14
4.15 fun dest_binder expected tm =
4.16 - dest_abs None (dest_monop expected tm)
4.17 + dest_abs NONE (dest_monop expected tm)
4.18 handle U.ERR _ => raise ERR "dest_binder" ("Not a(n) " ^ quote expected);
4.19
4.20
4.21 @@ -175,7 +175,7 @@
4.22
4.23 val strip_comb = strip (Library.swap o dest_comb) (* Goes to the "left" *)
4.24 val strip_imp = rev2swap o strip dest_imp
4.25 -val strip_abs = rev2swap o strip (dest_abs None)
4.26 +val strip_abs = rev2swap o strip (dest_abs NONE)
4.27 val strip_forall = rev2swap o strip dest_forall
4.28 val strip_exists = rev2swap o strip dest_exists
4.29
5.1 --- a/TFL/post.ML Fri Feb 11 18:51:00 2005 +0100
5.2 +++ b/TFL/post.ML Sun Feb 13 17:15:14 2005 +0100
5.3 @@ -207,7 +207,7 @@
5.4 -- Lucas Dixon, Aug 2004 *)
5.5 local
5.6 fun get_related_thms i =
5.7 - mapfilter ((fn (r,x) => if x = i then Some r else None));
5.8 + mapfilter ((fn (r,x) => if x = i then SOME r else NONE));
5.9
5.10 fun solve_eq (th, [], i) =
5.11 raise ERROR_MESSAGE "derive_init_eqs: missing rules"
6.1 --- a/TFL/rules.ML Fri Feb 11 18:51:00 2005 +0100
6.2 +++ b/TFL/rules.ML Sun Feb 13 17:15:14 2005 +0100
6.3 @@ -430,7 +430,7 @@
6.4 fun SUBS thl =
6.5 rewrite_rule (map (fn th => th RS eq_reflection handle THM _ => th) thl);
6.6
6.7 -val rew_conv = MetaSimplifier.rewrite_cterm (true, false, false) (K (K None));
6.8 +val rew_conv = MetaSimplifier.rewrite_cterm (true, false, false) (K (K NONE));
6.9
6.10 fun simpl_conv ss thl ctm =
6.11 rew_conv (ss addsimps thl) ctm RS meta_eq_to_obj_eq;
6.12 @@ -753,8 +753,8 @@
6.13 else q_eliminate (thm,imp,sign))
6.14 (* Assume that the leading constant is ==, *)
6.15 | _ => thm (* if it is not a ==> *)
6.16 - in Some(eliminate (rename thm)) end
6.17 - handle U.ERR _ => None (* FIXME handle THM as well?? *)
6.18 + in SOME(eliminate (rename thm)) end
6.19 + handle U.ERR _ => NONE (* FIXME handle THM as well?? *)
6.20
6.21 fun restrict_prover ss thm =
6.22 let val dummy = say "restrict_prover:"
6.23 @@ -797,8 +797,8 @@
6.24 (LIST_CONJ rcontext)
6.25 end
6.26 val th'' = th' RS thm
6.27 - in Some (th'')
6.28 - end handle U.ERR _ => None (* FIXME handle THM as well?? *)
6.29 + in SOME (th'')
6.30 + end handle U.ERR _ => NONE (* FIXME handle THM as well?? *)
6.31 in
6.32 (if (is_cong thm) then cong_prover else restrict_prover) ss thm
6.33 end
7.1 --- a/TFL/tfl.ML Fri Feb 11 18:51:00 2005 +0100
7.2 +++ b/TFL/tfl.ML Sun Feb 13 17:15:14 2005 +0100
7.3 @@ -260,8 +260,8 @@
7.4 let val pty as Type (ty_name,_) = type_of p
7.5 in
7.6 case (ty_info ty_name)
7.7 - of None => mk_case_fail("Not a known datatype: "^ty_name)
7.8 - | Some{case_const,constructors} =>
7.9 + of NONE => mk_case_fail("Not a known datatype: "^ty_name)
7.10 + | SOME{case_const,constructors} =>
7.11 let
7.12 val case_const_name = #1(dest_Const case_const)
7.13 val nrows = List.concat (map (expand constructors pty) rows)
7.14 @@ -371,7 +371,7 @@
7.15
7.16 (*For Isabelle, the lhs of a definition must be a constant.*)
7.17 fun mk_const_def sign (Name, Ty, rhs) =
7.18 - Sign.infer_types (Sign.pp sign) sign (K None) (K None) [] false
7.19 + Sign.infer_types (Sign.pp sign) sign (K NONE) (K NONE) [] false
7.20 ([Const("==",dummyT) $ Const(Name,Ty) $ rhs], propT)
7.21 |> #1;
7.22
7.23 @@ -623,7 +623,7 @@
7.24 val vlist = #2(S.strip_comb (S.rhs body))
7.25 val plist = ListPair.zip (vlist, xlist)
7.26 val args = map (fn qv => the (gen_assoc (op aconv) (plist, qv))) qvars
7.27 - handle Library.OPTION => sys_error
7.28 + handle Option => sys_error
7.29 "TFL fault [alpha_ex_unroll]: no correspondence"
7.30 fun build ex [] = []
7.31 | build (_$rex) (v::rst) =
7.32 @@ -666,8 +666,8 @@
7.33 let val Type (ty_name,_) = type_of p
7.34 in
7.35 case (ty_info ty_name)
7.36 - of None => fail("Not a known datatype: "^ty_name)
7.37 - | Some{constructors,nchotomy} =>
7.38 + of NONE => fail("Not a known datatype: "^ty_name)
7.39 + | SOME{constructors,nchotomy} =>
7.40 let val thm' = R.ISPEC (tych u) nchotomy
7.41 val disjuncts = S.strip_disj (concl thm')
7.42 val subproblems = divide(constructors, rows)
8.1 --- a/TFL/thry.ML Fri Feb 11 18:51:00 2005 +0100
8.2 +++ b/TFL/thry.ML Sun Feb 13 17:15:14 2005 +0100
8.3 @@ -58,14 +58,14 @@
8.4
8.5 fun match_info thy tname =
8.6 case (DatatypePackage.case_const_of thy tname, DatatypePackage.constrs_of thy tname) of
8.7 - (Some case_const, Some constructors) =>
8.8 - Some {case_const = case_const, constructors = constructors}
8.9 - | _ => None;
8.10 + (SOME case_const, SOME constructors) =>
8.11 + SOME {case_const = case_const, constructors = constructors}
8.12 + | _ => NONE;
8.13
8.14 fun induct_info thy tname = case get_info thy tname of
8.15 - None => None
8.16 - | Some {nchotomy, ...} =>
8.17 - Some {nchotomy = nchotomy,
8.18 + NONE => NONE
8.19 + | SOME {nchotomy, ...} =>
8.20 + SOME {nchotomy = nchotomy,
8.21 constructors = the (DatatypePackage.constrs_of thy tname)};
8.22
8.23 fun extract_info thy =
9.1 --- a/TFL/usyntax.ML Fri Feb 11 18:51:00 2005 +0100
9.2 +++ b/TFL/usyntax.ML Sun Feb 13 17:15:14 2005 +0100
9.3 @@ -385,11 +385,11 @@
9.4 (* Search a term for a sub-term satisfying the predicate p. *)
9.5 fun find_term p =
9.6 let fun find tm =
9.7 - if (p tm) then Some tm
9.8 + if (p tm) then SOME tm
9.9 else case tm of
9.10 Abs(_,_,body) => find body
9.11 - | (t$u) => (case find t of None => find u | some => some)
9.12 - | _ => None
9.13 + | (t$u) => (case find t of NONE => find u | some => some)
9.14 + | _ => NONE
9.15 in find
9.16 end;
9.17
10.1 --- a/src/CCL/CCL.ML Fri Feb 11 18:51:00 2005 +0100
10.2 +++ b/src/CCL/CCL.ML Sun Feb 13 17:15:14 2005 +0100
10.3 @@ -88,7 +88,7 @@
10.4 | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s);
10.5 val sg = sign_of thy;
10.6 val T = case Sign.const_type sg (Sign.intern_const (sign_of thy) sy) of
10.7 - None => error(sy^" not declared") | Some(T) => T;
10.8 + NONE => error(sy^" not declared") | SOME(T) => T;
10.9 val arity = length (fst (strip_type T));
10.10 in sy ^ (arg_str arity name "") end;
10.11
11.1 --- a/src/CTT/ex/elim.ML Fri Feb 11 18:51:00 2005 +0100
11.2 +++ b/src/CTT/ex/elim.ML Sun Feb 13 17:15:14 2005 +0100
11.3 @@ -3,7 +3,7 @@
11.4 Author: Lawrence C Paulson, Cambridge University Computer Laboratory
11.5 Copyright 1991 University of Cambridge
11.6
11.7 -Some examples taken from P. Martin-L\"of, Intuitionistic type theory
11.8 +SOME examples taken from P. Martin-L\"of, Intuitionistic type theory
11.9 (Bibliopolis, 1984).
11.10
11.11 by (safe_tac prems 1);
12.1 --- a/src/Cube/ex/ex.ML Fri Feb 11 18:51:00 2005 +0100
12.2 +++ b/src/Cube/ex/ex.ML Sun Feb 13 17:15:14 2005 +0100
12.3 @@ -201,7 +201,7 @@
12.4 by (EVERY[etac pi_elim 1, assume_tac 1, assume_tac 1]);
12.5 uresult();
12.6
12.7 -(* Some random examples *)
12.8 +(* SOME random examples *)
12.9
12.10 goal LP2.thy "A:* c:A f:A->A |- \
12.11 \ Lam a:A. Pi P:A->*.P^c -> (Pi x:A. P^x->P^(f^x)) -> P^a : ?T";
13.1 --- a/src/FOL/IFOL_lemmas.ML Fri Feb 11 18:51:00 2005 +0100
13.2 +++ b/src/FOL/IFOL_lemmas.ML Sun Feb 13 17:15:14 2005 +0100
13.3 @@ -204,7 +204,7 @@
13.4 by (REPEAT (ares_tac (prems@[exI,conjI,allI,impI]) 1)) ;
13.5 qed "ex1I";
13.6
13.7 -(*Sometimes easier to use: the premises have no shared variables. Safe!*)
13.8 +(*SOMEtimes easier to use: the premises have no shared variables. Safe!*)
13.9 val [ex,eq] = Goal
13.10 "[| EX x. P(x); !!x y. [| P(x); P(y) |] ==> x=y |] ==> EX! x. P(x)";
13.11 by (rtac (ex RS exE) 1);
14.1 --- a/src/FOL/eqrule_FOL_data.ML Fri Feb 11 18:51:00 2005 +0100
14.2 +++ b/src/FOL/eqrule_FOL_data.ML Sun Feb 13 17:15:14 2005 +0100
14.3 @@ -17,10 +17,10 @@
14.4 struct
14.5
14.6 fun mk_eq th = case concl_of th of
14.7 - Const("==",_)$_$_ => Some (th)
14.8 - | _$(Const("op <->",_)$_$_) => Some (th RS iff_reflection)
14.9 - | _$(Const("op =",_)$_$_) => Some (th RS eq_reflection)
14.10 - | _ => None;
14.11 + Const("==",_)$_$_ => SOME (th)
14.12 + | _$(Const("op <->",_)$_$_) => SOME (th RS iff_reflection)
14.13 + | _$(Const("op =",_)$_$_) => SOME (th RS eq_reflection)
14.14 + | _ => NONE;
14.15
14.16 val tranformation_pairs =
14.17 [("op -->", [mp]), ("op &", [conjunct1,conjunct2]),
14.18 @@ -37,8 +37,8 @@
14.19 (case Term.head_of p of
14.20 Const(a,_) =>
14.21 (case Library.assoc(pairs,a) of
14.22 - Some(rls) => flat (map atoms ([th] RL rls))
14.23 - | None => [th])
14.24 + SOME(rls) => flat (map atoms ([th] RL rls))
14.25 + | NONE => [th])
14.26 | _ => [th])
14.27 | _ => [th])
14.28 in atoms end;
15.1 --- a/src/FOL/ex/int.ML Fri Feb 11 18:51:00 2005 +0100
15.2 +++ b/src/FOL/ex/int.ML Sun Feb 13 17:15:14 2005 +0100
15.3 @@ -296,7 +296,7 @@
15.4 writeln"Hard examples with quantifiers";
15.5
15.6 (*The ones that have not been proved are not known to be valid!
15.7 - Some will require quantifier duplication -- not currently available*)
15.8 + SOME will require quantifier duplication -- not currently available*)
15.9
15.10 writeln"Problem ~~18";
15.11 Goal "~~(EX y. ALL x. P(y)-->P(x))";
16.1 --- a/src/FOL/ex/intro.ML Fri Feb 11 18:51:00 2005 +0100
16.2 +++ b/src/FOL/ex/intro.ML Sun Feb 13 17:15:14 2005 +0100
16.3 @@ -14,7 +14,7 @@
16.4
16.5 context FOL.thy;
16.6
16.7 -(**** Some simple backward proofs ****)
16.8 +(**** SOME simple backward proofs ****)
16.9
16.10 Goal "P|P --> P";
16.11 by (rtac impI 1);
17.1 --- a/src/FOL/ex/quant.ML Fri Feb 11 18:51:00 2005 +0100
17.2 +++ b/src/FOL/ex/quant.ML Sun Feb 13 17:15:14 2005 +0100
17.3 @@ -34,7 +34,7 @@
17.4 result();
17.5
17.6
17.7 -writeln"Some harder ones";
17.8 +writeln"SOME harder ones";
17.9
17.10 Goal "(EX x. P(x) | Q(x)) <-> (EX x. P(x)) | (EX x. Q(x))";
17.11 by tac;
17.12 @@ -104,7 +104,7 @@
17.13 result();
17.14
17.15
17.16 -writeln"Some slow ones";
17.17 +writeln"SOME slow ones";
17.18
17.19
17.20 (*Principia Mathematica *11.53 *)
18.1 --- a/src/FOL/simpdata.ML Fri Feb 11 18:51:00 2005 +0100
18.2 +++ b/src/FOL/simpdata.ML Sun Feb 13 17:15:14 2005 +0100
18.3 @@ -116,8 +116,8 @@
18.4 (case head_of p of
18.5 Const(a,_) =>
18.6 (case assoc(pairs,a) of
18.7 - Some(rls) => flat (map atoms ([th] RL rls))
18.8 - | None => [th])
18.9 + SOME(rls) => flat (map atoms ([th] RL rls))
18.10 + | NONE => [th])
18.11 | _ => [th])
18.12 | _ => [th])
18.13 in atoms end;
18.14 @@ -239,12 +239,12 @@
18.15 structure Quantifier1 = Quantifier1Fun(
18.16 struct
18.17 (*abstract syntax*)
18.18 - fun dest_eq((c as Const("op =",_)) $ s $ t) = Some(c,s,t)
18.19 - | dest_eq _ = None;
18.20 - fun dest_conj((c as Const("op &",_)) $ s $ t) = Some(c,s,t)
18.21 - | dest_conj _ = None;
18.22 - fun dest_imp((c as Const("op -->",_)) $ s $ t) = Some(c,s,t)
18.23 - | dest_imp _ = None;
18.24 + fun dest_eq((c as Const("op =",_)) $ s $ t) = SOME(c,s,t)
18.25 + | dest_eq _ = NONE;
18.26 + fun dest_conj((c as Const("op &",_)) $ s $ t) = SOME(c,s,t)
18.27 + | dest_conj _ = NONE;
18.28 + fun dest_imp((c as Const("op -->",_)) $ s $ t) = SOME(c,s,t)
18.29 + | dest_imp _ = NONE;
18.30 val conj = FOLogic.conj
18.31 val imp = FOLogic.imp
18.32 (*rules*)
19.1 --- a/src/FOLP/ex/int.ML Fri Feb 11 18:51:00 2005 +0100
19.2 +++ b/src/FOLP/ex/int.ML Sun Feb 13 17:15:14 2005 +0100
19.3 @@ -231,7 +231,7 @@
19.4 writeln"Hard examples with quantifiers";
19.5
19.6 (*The ones that have not been proved are not known to be valid!
19.7 - Some will require quantifier duplication -- not currently available*)
19.8 + SOME will require quantifier duplication -- not currently available*)
19.9
19.10 writeln"Problem ~~18";
19.11 goal IFOLP.thy "?p : ~~(EX y. ALL x. P(y)-->P(x))";
20.1 --- a/src/FOLP/ex/intro.ML Fri Feb 11 18:51:00 2005 +0100
20.2 +++ b/src/FOLP/ex/intro.ML Sun Feb 13 17:15:14 2005 +0100
20.3 @@ -12,7 +12,7 @@
20.4 *)
20.5
20.6
20.7 -(**** Some simple backward proofs ****)
20.8 +(**** SOME simple backward proofs ****)
20.9
20.10 goal FOLP.thy "?p:P|P --> P";
20.11 by (rtac impI 1);
21.1 --- a/src/FOLP/ex/quant.ML Fri Feb 11 18:51:00 2005 +0100
21.2 +++ b/src/FOLP/ex/quant.ML Sun Feb 13 17:15:14 2005 +0100
21.3 @@ -34,7 +34,7 @@
21.4 result();
21.5
21.6
21.7 -writeln"Some harder ones";
21.8 +writeln"SOME harder ones";
21.9
21.10 Goal "?p : (EX x. P(x) | Q(x)) <-> (EX x. P(x)) | (EX x. Q(x))";
21.11 by tac;
21.12 @@ -104,7 +104,7 @@
21.13 result();
21.14
21.15
21.16 -writeln"Some slow ones";
21.17 +writeln"SOME slow ones";
21.18
21.19
21.20 (*Principia Mathematica *11.53 *)
22.1 --- a/src/FOLP/simp.ML Fri Feb 11 18:51:00 2005 +0100
22.2 +++ b/src/FOLP/simp.ML Sun Feb 13 17:15:14 2005 +0100
22.3 @@ -136,8 +136,8 @@
22.4
22.5 (*Applies tactic and returns the first resulting state, FAILS if none!*)
22.6 fun one_result(tac,thm) = case Seq.pull(tac thm) of
22.7 - Some(thm',_) => thm'
22.8 - | None => raise THM("Simplifier: could not continue", 0, [thm]);
22.9 + SOME(thm',_) => thm'
22.10 + | NONE => raise THM("Simplifier: could not continue", 0, [thm]);
22.11
22.12 fun res1(thm,thms,i) = one_result(resolve_tac thms i,thm);
22.13
22.14 @@ -180,8 +180,8 @@
22.15 Abs (_,_,body) => add_vars(body,vars)
22.16 | r$s => (case head_of tm of
22.17 Const(c,T) => (case assoc(new_asms,c) of
22.18 - None => add_vars(r,add_vars(s,vars))
22.19 - | Some(al) => add_list(tm,al,vars))
22.20 + NONE => add_vars(r,add_vars(s,vars))
22.21 + | SOME(al) => add_list(tm,al,vars))
22.22 | _ => add_vars(r,add_vars(s,vars)))
22.23 | _ => vars
22.24 in add_vars end;
22.25 @@ -211,7 +211,7 @@
22.26 | Free _ => resolve_tac congs 1 ORELSE refl1_tac
22.27 | _ => refl1_tac)
22.28 val add_norm_tac = DEPTH_FIRST (has_fewer_prems nops) norm_step_tac
22.29 - val Some(thm'',_) = Seq.pull(add_norm_tac thm')
22.30 + val SOME(thm'',_) = Seq.pull(add_norm_tac thm')
22.31 in thm'' end;
22.32
22.33 fun add_norm_tags congs =
22.34 @@ -423,14 +423,14 @@
22.35 if var_lhs(thm,i) then (ss,thm,anet,ats,cs) else
22.36 if lhs_is_NORM(thm,i) then (ss, res1(thm,trans_norms,i), anet,ats,cs)
22.37 else case Seq.pull(cong_tac i thm) of
22.38 - Some(thm',_) =>
22.39 + SOME(thm',_) =>
22.40 let val ps = prems_of thm and ps' = prems_of thm';
22.41 val n = length(ps')-length(ps);
22.42 val a = length(strip_assums_hyp(nth_elem(i-1,ps)))
22.43 val l = map (fn p => length(strip_assums_hyp(p)))
22.44 (take(n,drop(i-1,ps')));
22.45 in (simp_refl(rev(l),a,REW::ss),thm',anet,ats,cs) end
22.46 - | None => (REW::ss,thm,anet,ats,cs);
22.47 + | NONE => (REW::ss,thm,anet,ats,cs);
22.48
22.49 (*NB: the "Adding rewrites:" trace will look strange because assumptions
22.50 are represented by rules, generalized over their parameters*)
22.51 @@ -447,22 +447,22 @@
22.52 end;
22.53
22.54 fun rew(seq,thm,ss,anet,ats,cs, more) = case Seq.pull seq of
22.55 - Some(thm',seq') =>
22.56 + SOME(thm',seq') =>
22.57 let val n = (nprems_of thm') - (nprems_of thm)
22.58 in pr_rew(i,n,thm,thm',more);
22.59 if n=0 then (SIMP_LHS::ss, thm', anet, ats, cs)
22.60 else ((replicate n PROVE) @ (POP_CS::SIMP_LHS::ss),
22.61 thm', anet, ats, (ss,thm,anet,ats,seq',more)::cs)
22.62 end
22.63 - | None => if more
22.64 + | NONE => if more
22.65 then rew((lhs_net_tac anet i THEN assume_tac i) thm,
22.66 thm,ss,anet,ats,cs,false)
22.67 else (ss,thm,anet,ats,cs);
22.68
22.69 fun try_true(thm,ss,anet,ats,cs) =
22.70 case Seq.pull(auto_tac i thm) of
22.71 - Some(thm',_) => (ss,thm',anet,ats,cs)
22.72 - | None => let val (ss0,thm0,anet0,ats0,seq,more)::cs0 = cs
22.73 + SOME(thm',_) => (ss,thm',anet,ats,cs)
22.74 + | NONE => let val (ss0,thm0,anet0,ats0,seq,more)::cs0 = cs
22.75 in if !tracing
22.76 then (writeln"*** Failed to prove precondition. Normal form:";
22.77 pr_goal_concl i thm; writeln"")
22.78 @@ -472,8 +472,8 @@
22.79
22.80 fun if_exp(thm,ss,anet,ats,cs) =
22.81 case Seq.pull (IF1_TAC (cong_tac i) i thm) of
22.82 - Some(thm',_) => (SIMP_LHS::IF::ss,thm',anet,ats,cs)
22.83 - | None => (ss,thm,anet,ats,cs);
22.84 + SOME(thm',_) => (SIMP_LHS::IF::ss,thm',anet,ats,cs)
22.85 + | NONE => (ss,thm,anet,ats,cs);
22.86
22.87 fun step(s::ss, thm, anet, ats, cs) = case s of
22.88 MK_EQ => (ss, res1(thm,[red2],i), anet, ats, cs)
22.89 @@ -549,10 +549,10 @@
22.90 let val (Const(_,cT), va, vb) = dest_red(hd(prems_of thm));
22.91 val [P] = add_term_vars(concl_of thm,[]) \\ [va,vb]
22.92 val eqT::_ = binder_types cT
22.93 - in if Type.typ_instance tsig (T,eqT) then Some(thm,va,vb,P)
22.94 + in if Type.typ_instance tsig (T,eqT) then SOME(thm,va,vb,P)
22.95 else find thms
22.96 end
22.97 - | find [] = None
22.98 + | find [] = NONE
22.99 in find subst_thms end;
22.100
22.101 fun mk_cong sg (f,aTs,rT) (refl,eq) =
22.102 @@ -569,8 +569,8 @@
22.103 fun mk(c,T::Ts,i,yik) =
22.104 let val si = radixstring(26,"a",i)
22.105 in case find_subst tsig T of
22.106 - None => mk(c,Ts,i-1,eta_Var(("X"^si,0),T)::yik)
22.107 - | Some s => let val c' = c RSN (2,ri(s,i,si,T,yik))
22.108 + NONE => mk(c,Ts,i-1,eta_Var(("X"^si,0),T)::yik)
22.109 + | SOME s => let val c' = c RSN (2,ri(s,i,si,T,yik))
22.110 in mk(c',Ts,i-1,eta_Var(("Y"^si,0),T)::yik) end
22.111 end
22.112 | mk(c,[],_,_) = c;
22.113 @@ -582,17 +582,17 @@
22.114 fun find_refl(r::rs) =
22.115 let val (Const(eq,eqT),_,_) = dest_red(concl_of r)
22.116 in if Type.typ_instance tsig (rT, hd(binder_types eqT))
22.117 - then Some(r,(eq,body_type eqT)) else find_refl rs
22.118 + then SOME(r,(eq,body_type eqT)) else find_refl rs
22.119 end
22.120 - | find_refl([]) = None;
22.121 + | find_refl([]) = NONE;
22.122 in case find_refl refl_thms of
22.123 - None => [] | Some(refl) => [mk_cong sg (f,aTs,rT) refl]
22.124 + NONE => [] | SOME(refl) => [mk_cong sg (f,aTs,rT) refl]
22.125 end;
22.126
22.127 fun mk_cong_thy thy f =
22.128 let val sg = sign_of thy;
22.129 val T = case Sign.const_type sg f of
22.130 - None => error(f^" not declared") | Some(T) => T;
22.131 + NONE => error(f^" not declared") | SOME(T) => T;
22.132 val T' = incr_tvar 9 T;
22.133 in mk_cong_type sg (Const(f,T'),T') end;
22.134
22.135 @@ -602,9 +602,9 @@
22.136 let val sg = sign_of thy;
22.137 val S0 = Sign.defaultS sg;
22.138 fun readfT(f,s) =
22.139 - let val T = incr_tvar 9 (Sign.read_typ(sg,K(Some(S0))) s);
22.140 + let val T = incr_tvar 9 (Sign.read_typ(sg,K(SOME(S0))) s);
22.141 val t = case Sign.const_type sg f of
22.142 - Some(_) => Const(f,T) | None => Free(f,T)
22.143 + SOME(_) => Const(f,T) | NONE => Free(f,T)
22.144 in (t,T) end
22.145 in flat o map (mk_cong_type sg o readfT) end;
22.146
23.1 --- a/src/FOLP/simpdata.ML Fri Feb 11 18:51:00 2005 +0100
23.2 +++ b/src/FOLP/simpdata.ML Sun Feb 13 17:15:14 2005 +0100
23.3 @@ -85,8 +85,8 @@
23.4 (case head_of p of
23.5 Const(a,_) =>
23.6 (case assoc(pairs,a) of
23.7 - Some(rls) => flat (map atoms ([th] RL rls))
23.8 - | None => [th])
23.9 + SOME(rls) => flat (map atoms ([th] RL rls))
23.10 + | NONE => [th])
23.11 | _ => [th])
23.12 | _ => [th])
23.13 in atoms end;
24.1 --- a/src/HOL/Algebra/abstract/Ring.thy Fri Feb 11 18:51:00 2005 +0100
24.2 +++ b/src/HOL/Algebra/abstract/Ring.thy Sun Feb 13 17:15:14 2005 +0100
24.3 @@ -170,8 +170,8 @@
24.4 |> mk_meta_eq;
24.5 val (t', u) = Logic.dest_equals (Thm.prop_of rew);
24.6 in if t' aconv u
24.7 - then None
24.8 - else Some rew
24.9 + then NONE
24.10 + else SOME rew
24.11 end;
24.12 in
24.13 val ring_simproc = Simplifier.simproc (sign_of (the_context ())) "ring" lhss proc;
25.1 --- a/src/HOL/Algebra/abstract/order.ML Fri Feb 11 18:51:00 2005 +0100
25.2 +++ b/src/HOL/Algebra/abstract/order.ML Sun Feb 13 17:15:14 2005 +0100
25.3 @@ -60,7 +60,7 @@
25.4
25.5 fun termless_ring (a, b) = (term_lpo ring_ord (a, b) = LESS);
25.6
25.7 -(* Some code useful for debugging
25.8 +(* SOME code useful for debugging
25.9
25.10 val intT = HOLogic.intT;
25.11 val a = Free ("a", intT);
26.1 --- a/src/HOL/Algebra/ringsimp.ML Fri Feb 11 18:51:00 2005 +0100
26.2 +++ b/src/HOL/Algebra/ringsimp.ML Sun Feb 13 17:15:14 2005 +0100
26.3 @@ -82,9 +82,9 @@
26.4 ("Non-commutative rings in proof context: " ^ commas non_comm_rings ^
26.5 "\nCommutative rings in proof context: " ^ commas comm_rings);
26.6 val simps =
26.7 - flat (map (fn s => ProofContext.get_thms ctxt (s ^ ".ring_simprules", None))
26.8 + flat (map (fn s => ProofContext.get_thms ctxt (s ^ ".ring_simprules", NONE))
26.9 non_comm_rings) @
26.10 - flat (map (fn s => ProofContext.get_thms ctxt (s ^ ".cring_simprules", None))
26.11 + flat (map (fn s => ProofContext.get_thms ctxt (s ^ ".cring_simprules", NONE))
26.12 comm_rings);
26.13 in Method.SIMPLE_METHOD' HEADGOAL (asm_full_simp_tac (cring_ss addsimps simps))
26.14 end;
27.1 --- a/src/HOL/Bali/Basis.thy Fri Feb 11 18:51:00 2005 +0100
27.2 +++ b/src/HOL/Bali/Basis.thy Sun Feb 13 17:15:14 2005 +0100
27.3 @@ -20,7 +20,7 @@
27.4
27.5 ML {*
27.6 fun cond_simproc name pat pred thm = Simplifier.simproc (Thm.sign_of_thm thm) name [pat]
27.7 - (fn _ => fn _ => fn t => if pred t then None else Some (mk_meta_eq thm));
27.8 + (fn _ => fn _ => fn t => if pred t then NONE else SOME (mk_meta_eq thm));
27.9 *}
27.10
27.11 declare split_if_asm [split] option.split [split] option.split_asm [split]
28.1 --- a/src/HOL/Extraction.thy Fri Feb 11 18:51:00 2005 +0100
28.2 +++ b/src/HOL/Extraction.thy Sun Feb 13 17:15:14 2005 +0100
28.3 @@ -15,19 +15,19 @@
28.4 ML_setup {*
28.5 fun realizes_set_proc (Const ("realizes", Type ("fun", [Type ("Null", []), _])) $ r $
28.6 (Const ("op :", _) $ x $ S)) = (case strip_comb S of
28.7 - (Var (ixn, U), ts) => Some (list_comb (Var (ixn, binder_types U @
28.8 + (Var (ixn, U), ts) => SOME (list_comb (Var (ixn, binder_types U @
28.9 [HOLogic.dest_setT (body_type U)] ---> HOLogic.boolT), ts @ [x]))
28.10 - | (Free (s, U), ts) => Some (list_comb (Free (s, binder_types U @
28.11 + | (Free (s, U), ts) => SOME (list_comb (Free (s, binder_types U @
28.12 [HOLogic.dest_setT (body_type U)] ---> HOLogic.boolT), ts @ [x]))
28.13 - | _ => None)
28.14 + | _ => NONE)
28.15 | realizes_set_proc (Const ("realizes", Type ("fun", [T, _])) $ r $
28.16 (Const ("op :", _) $ x $ S)) = (case strip_comb S of
28.17 - (Var (ixn, U), ts) => Some (list_comb (Var (ixn, T :: binder_types U @
28.18 + (Var (ixn, U), ts) => SOME (list_comb (Var (ixn, T :: binder_types U @
28.19 [HOLogic.dest_setT (body_type U)] ---> HOLogic.boolT), r :: ts @ [x]))
28.20 - | (Free (s, U), ts) => Some (list_comb (Free (s, T :: binder_types U @
28.21 + | (Free (s, U), ts) => SOME (list_comb (Free (s, T :: binder_types U @
28.22 [HOLogic.dest_setT (body_type U)] ---> HOLogic.boolT), r :: ts @ [x]))
28.23 - | _ => None)
28.24 - | realizes_set_proc _ = None;
28.25 + | _ => NONE)
28.26 + | realizes_set_proc _ = NONE;
28.27
28.28 fun mk_realizes_set r rT s (setT as Type ("set", [elT])) =
28.29 Abs ("x", elT, Const ("realizes", rT --> HOLogic.boolT --> HOLogic.boolT) $
28.30 @@ -36,8 +36,8 @@
28.31
28.32 Context.>> (fn thy => thy |>
28.33 Extraction.add_types
28.34 - [("bool", ([], None)),
28.35 - ("set", ([realizes_set_proc], Some mk_realizes_set))] |>
28.36 + [("bool", ([], NONE)),
28.37 + ("set", ([realizes_set_proc], SOME mk_realizes_set))] |>
28.38 Extraction.set_preprocessor (fn sg =>
28.39 Proofterm.rewrite_proof_notypes
28.40 ([], ("HOL/elim_cong", RewriteHOLProof.elim_cong) ::
29.1 --- a/src/HOL/Fun.thy Fri Feb 11 18:51:00 2005 +0100
29.2 +++ b/src/HOL/Fun.thy Sun Feb 13 17:15:14 2005 +0100
29.3 @@ -474,14 +474,14 @@
29.4
29.5 (* simplifies terms of the form f(...,x:=y,...,x:=z,...) to f(...,x:=z,...) *)
29.6 local
29.7 - fun gen_fun_upd None T _ _ = None
29.8 - | gen_fun_upd (Some f) T x y = Some (Const ("Fun.fun_upd",T) $ f $ x $ y)
29.9 + fun gen_fun_upd NONE T _ _ = NONE
29.10 + | gen_fun_upd (SOME f) T x y = SOME (Const ("Fun.fun_upd",T) $ f $ x $ y)
29.11 fun dest_fun_T1 (Type (_, T :: Ts)) = T
29.12 fun find_double (t as Const ("Fun.fun_upd",T) $ f $ x $ y) =
29.13 let
29.14 fun find (Const ("Fun.fun_upd",T) $ g $ v $ w) =
29.15 - if v aconv x then Some g else gen_fun_upd (find g) T v w
29.16 - | find t = None
29.17 + if v aconv x then SOME g else gen_fun_upd (find g) T v w
29.18 + | find t = NONE
29.19 in (dest_fun_T1 T, gen_fun_upd (find f) T x y) end
29.20
29.21 val ss = simpset ()
29.22 @@ -491,8 +491,8 @@
29.23 Simplifier.simproc (Theory.sign_of (the_context ()))
29.24 "fun_upd2" ["f(v := w, x := y)"]
29.25 (fn sg => fn _ => fn t =>
29.26 - case find_double t of (T, None) => None
29.27 - | (T, Some rhs) => Some (Tactic.prove sg [] [] (Term.equals T $ t $ rhs) fun_upd_prover))
29.28 + case find_double t of (T, NONE) => NONE
29.29 + | (T, SOME rhs) => SOME (Tactic.prove sg [] [] (Term.equals T $ t $ rhs) fun_upd_prover))
29.30 end;
29.31 Addsimprocs[fun_upd2_simproc];
29.32
30.1 --- a/src/HOL/Hoare/hoare.ML Fri Feb 11 18:51:00 2005 +0100
30.2 +++ b/src/HOL/Hoare/hoare.ML Sun Feb 13 17:15:14 2005 +0100
30.3 @@ -89,7 +89,7 @@
30.4
30.5 (*****************************************************************************)
30.6 (** Simplifying: **)
30.7 -(** Some useful lemmata, lists and simplification tactics to control which **)
30.8 +(** SOME useful lemmata, lists and simplification tactics to control which **)
30.9 (** theorems are used to simplify at each moment, so that the original **)
30.10 (** input does not suffer any unexpected transformation **)
30.11 (*****************************************************************************)
31.1 --- a/src/HOL/Hoare/hoareAbort.ML Fri Feb 11 18:51:00 2005 +0100
31.2 +++ b/src/HOL/Hoare/hoareAbort.ML Sun Feb 13 17:15:14 2005 +0100
31.3 @@ -90,7 +90,7 @@
31.4
31.5 (*****************************************************************************)
31.6 (** Simplifying: **)
31.7 -(** Some useful lemmata, lists and simplification tactics to control which **)
31.8 +(** SOME useful lemmata, lists and simplification tactics to control which **)
31.9 (** theorems are used to simplify at each moment, so that the original **)
31.10 (** input does not suffer any unexpected transformation **)
31.11 (*****************************************************************************)
32.1 --- a/src/HOL/HoareParallel/OG_Syntax.thy Fri Feb 11 18:51:00 2005 +0100
32.2 +++ b/src/HOL/HoareParallel/OG_Syntax.thy Sun Feb 13 17:15:14 2005 +0100
32.3 @@ -96,8 +96,8 @@
32.4
32.5 fun upd_tr' (x_upd, T) =
32.6 (case try (unsuffix RecordPackage.updateN) x_upd of
32.7 - Some x => (x, if T = dummyT then T else Term.domain_type T)
32.8 - | None => raise Match);
32.9 + SOME x => (x, if T = dummyT then T else Term.domain_type T)
32.10 + | NONE => raise Match);
32.11
32.12 fun update_name_tr' (Free x) = Free (upd_tr' x)
32.13 | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
33.1 --- a/src/HOL/HoareParallel/RG_Syntax.thy Fri Feb 11 18:51:00 2005 +0100
33.2 +++ b/src/HOL/HoareParallel/RG_Syntax.thy Sun Feb 13 17:15:14 2005 +0100
33.3 @@ -69,8 +69,8 @@
33.4
33.5 fun upd_tr' (x_upd, T) =
33.6 (case try (unsuffix RecordPackage.updateN) x_upd of
33.7 - Some x => (x, if T = dummyT then T else Term.domain_type T)
33.8 - | None => raise Match);
33.9 + SOME x => (x, if T = dummyT then T else Term.domain_type T)
33.10 + | NONE => raise Match);
33.11
33.12 fun update_name_tr' (Free x) = Free (upd_tr' x)
33.13 | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
34.1 --- a/src/HOL/Hyperreal/NSA.thy Fri Feb 11 18:51:00 2005 +0100
34.2 +++ b/src/HOL/Hyperreal/NSA.thy Sun Feb 13 17:15:14 2005 +0100
34.3 @@ -606,10 +606,10 @@
34.4 0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
34.5 fun reorient_proc sg _ (_ $ t $ u) =
34.6 case u of
34.7 - Const("0", _) => None
34.8 - | Const("1", _) => None
34.9 - | Const("Numeral.number_of", _) $ _ => None
34.10 - | _ => Some (case t of
34.11 + Const("0", _) => NONE
34.12 + | Const("1", _) => NONE
34.13 + | Const("Numeral.number_of", _) $ _ => NONE
34.14 + | _ => SOME (case t of
34.15 Const("0", _) => meta_zero_approx_reorient
34.16 | Const("1", _) => meta_one_approx_reorient
34.17 | Const("Numeral.number_of", _) $ _ =>
35.1 --- a/src/HOL/Import/hol4rews.ML Fri Feb 11 18:51:00 2005 +0100
35.2 +++ b/src/HOL/Import/hol4rews.ML Sun Feb 13 17:15:14 2005 +0100
35.3 @@ -149,7 +149,7 @@
35.4 val merge : T * T -> T = StringPair.merge (K true)
35.5 fun print sg tab =
35.6 Pretty.writeln (Pretty.big_list "HOL4 mappings:"
35.7 - (StringPair.foldl (fn (xl,((bthy,bthm),isathm)) => (Pretty.str (bthy ^ "." ^ bthm ^ (case isathm of Some th => " --> " ^ th | None => "IGNORED"))::xl)) ([],tab)))
35.8 + (StringPair.foldl (fn (xl,((bthy,bthm),isathm)) => (Pretty.str (bthy ^ "." ^ bthm ^ (case isathm of SOME th => " --> " ^ th | NONE => "IGNORED"))::xl)) ([],tab)))
35.9 end;
35.10
35.11 structure HOL4Maps = TheoryDataFun(HOL4MapsArgs);
35.12 @@ -277,7 +277,7 @@
35.13 let
35.14 val _ = message ("Ignoring " ^ bthy ^ "." ^ bthm)
35.15 val curmaps = HOL4Maps.get thy
35.16 - val newmaps = StringPair.update_new(((bthy,bthm),None),curmaps)
35.17 + val newmaps = StringPair.update_new(((bthy,bthm),NONE),curmaps)
35.18 val upd_thy = HOL4Maps.put newmaps thy
35.19 in
35.20 upd_thy
35.21 @@ -312,8 +312,8 @@
35.22 val moves = HOL4Moves.get thy
35.23 fun F thmname =
35.24 case Symtab.lookup(moves,thmname) of
35.25 - Some name => F name
35.26 - | None => thmname
35.27 + SOME name => F name
35.28 + | NONE => thmname
35.29 in
35.30 F thmname
35.31 end
35.32 @@ -338,8 +338,8 @@
35.33 val moves = HOL4CMoves.get thy
35.34 fun F thmname =
35.35 case Symtab.lookup(moves,thmname) of
35.36 - Some name => F name
35.37 - | None => thmname
35.38 + SOME name => F name
35.39 + | NONE => thmname
35.40 in
35.41 F thmname
35.42 end
35.43 @@ -349,7 +349,7 @@
35.44 val isathm = follow_name isathm thy
35.45 val _ = message ("Adding theorem map: " ^ bthy ^ "." ^ bthm ^ " --> " ^ isathm)
35.46 val curmaps = HOL4Maps.get thy
35.47 - val newmaps = StringPair.update_new(((bthy,bthm),Some isathm),curmaps)
35.48 + val newmaps = StringPair.update_new(((bthy,bthm),SOME isathm),curmaps)
35.49 val upd_thy = HOL4Maps.put newmaps thy
35.50 in
35.51 upd_thy
35.52 @@ -378,7 +378,7 @@
35.53 else thy
35.54 val _ = message ("Adding cmap " ^ bthy ^ "." ^ bconst ^ " -> " ^ isaconst ^ (if internal then " (*)" else ""))
35.55 val curmaps = HOL4ConstMaps.get thy
35.56 - val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst,None)),curmaps)
35.57 + val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst,NONE)),curmaps)
35.58 val upd_thy = HOL4ConstMaps.put newmaps thy
35.59 in
35.60 upd_thy
35.61 @@ -404,8 +404,8 @@
35.62 fun get_hol4_const_mapping bthy bconst thy =
35.63 let
35.64 val bconst = case get_hol4_const_renaming bthy bconst thy of
35.65 - Some name => name
35.66 - | None => bconst
35.67 + SOME name => name
35.68 + | NONE => bconst
35.69 val maps = HOL4ConstMaps.get thy
35.70 in
35.71 StringPair.lookup(maps,(bthy,bconst))
35.72 @@ -420,7 +420,7 @@
35.73 else thy
35.74 val _ = message ("Adding cmap " ^ bthy ^ "." ^ bconst ^ " -> " ^ isaconst ^ (if internal then " (*)" else ""))
35.75 val curmaps = HOL4ConstMaps.get thy
35.76 - val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst,Some typ)),curmaps)
35.77 + val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst,SOME typ)),curmaps)
35.78 val upd_thy = HOL4ConstMaps.put newmaps thy
35.79 in
35.80 upd_thy
35.81 @@ -549,7 +549,7 @@
35.82
35.83 fun should_ignore thyname thy thmname =
35.84 case get_hol4_mapping thyname thmname thy of
35.85 - Some None => true
35.86 + SOME NONE => true
35.87 | _ => false
35.88
35.89 val trans_string =
35.90 @@ -577,8 +577,8 @@
35.91 StringPair.foldl (fn ((ign,map),((bthy,bthm),v)) =>
35.92 if bthy = thyname
35.93 then (case v of
35.94 - None => (bthm::ign,map)
35.95 - | Some w => (ign,(bthm,w)::map))
35.96 + NONE => (bthm::ign,map)
35.97 + | SOME w => (ign,(bthm,w)::map))
35.98 else (ign,map))
35.99 (([],[]),HOL4Maps.get thy)
35.100 val constmaps =
35.101 @@ -650,8 +650,8 @@
35.102 val _ = app (fn (hol,(internal,isa,opt_ty)) =>
35.103 (out ("\n " ^ (trans_string hol) ^ " > " ^ (trans_string (follow_cname isa thy)));
35.104 case opt_ty of
35.105 - Some ty => out (" :: \"" ^ (string_of_ctyp (ctyp_of sg ty)) ^ "\"")
35.106 - | None => ())) constmaps
35.107 + SOME ty => out (" :: \"" ^ (string_of_ctyp (ctyp_of sg ty)) ^ "\"")
35.108 + | NONE => ())) constmaps
35.109 val _ = if null constmaps
35.110 then ()
35.111 else out "\n\n"
35.112 @@ -721,8 +721,8 @@
35.113 fun F dname = (dname,add_defmap thyname name dname thy)
35.114 in
35.115 case StringPair.lookup(maps,(thyname,name)) of
35.116 - Some thmname => (thmname,thy)
35.117 - | None =>
35.118 + SOME thmname => (thmname,thy)
35.119 + | NONE =>
35.120 let
35.121 val used = HOL4UNames.get thy
35.122 val defname = def_name name
36.1 --- a/src/HOL/Import/import_package.ML Fri Feb 11 18:51:00 2005 +0100
36.2 +++ b/src/HOL/Import/import_package.ML Sun Feb 13 17:15:14 2005 +0100
36.3 @@ -14,10 +14,10 @@
36.4 struct
36.5 val name = "HOL4/import_data"
36.6 type T = ProofKernel.thm option array option
36.7 -val empty = None
36.8 +val empty = NONE
36.9 val copy = I
36.10 val prep_ext = I
36.11 -fun merge _ = None
36.12 +fun merge _ = NONE
36.13 fun print sg import_segment =
36.14 Pretty.writeln (Pretty.str ("Pretty printing of importer data not implemented"))
36.15 end
36.16 @@ -44,8 +44,8 @@
36.17 val prem = hd (prems_of th)
36.18 val _ = message ("Import trying to prove " ^ (string_of_cterm (cterm_of sg prem)))
36.19 val int_thms = case ImportData.get thy of
36.20 - None => fst (Replay.setup_int_thms thyname thy)
36.21 - | Some a => a
36.22 + NONE => fst (Replay.setup_int_thms thyname thy)
36.23 + | SOME a => a
36.24 val proof = snd (ProofKernel.import_proof thyname thmname thy) thy
36.25 val hol4thm = snd (Replay.replay_proof int_thms thyname thmname proof thy)
36.26 val thm = snd (ProofKernel.to_isa_thm hol4thm)
36.27 @@ -56,7 +56,7 @@
36.28 val _ = message ("Import proved " ^ (string_of_thm thm))
36.29 in
36.30 case Shuffler.set_prop thy prem' [("",thm)] of
36.31 - Some (_,thm) =>
36.32 + SOME (_,thm) =>
36.33 let
36.34 val _ = if prem' aconv (prop_of thm)
36.35 then message "import: Terms match up"
36.36 @@ -66,7 +66,7 @@
36.37 in
36.38 res
36.39 end
36.40 - | None => (message "import: set_prop didn't succeed"; no_tac th)
36.41 + | NONE => (message "import: set_prop didn't succeed"; no_tac th)
36.42 end
36.43
36.44 val import_meth = Method.simple_args (Args.name -- Args.name)
37.1 --- a/src/HOL/Import/import_syntax.ML Fri Feb 11 18:51:00 2005 +0100
37.2 +++ b/src/HOL/Import/import_syntax.ML Sun Feb 13 17:15:14 2005 +0100
37.3 @@ -113,8 +113,8 @@
37.4 let
37.5 val thyname = get_import_thy thy
37.6 in
37.7 - foldl (fn (thy,((hol,isa),None)) => add_hol4_const_mapping thyname hol false isa thy
37.8 - | (thy,((hol,isa),Some ty)) => add_hol4_const_wt_mapping thyname hol false isa (typ_of (read_ctyp (sign_of thy) ty)) thy) (thy,constmaps)
37.9 + foldl (fn (thy,((hol,isa),NONE)) => add_hol4_const_mapping thyname hol false isa thy
37.10 + | (thy,((hol,isa),SOME ty)) => add_hol4_const_wt_mapping thyname hol false isa (typ_of (read_ctyp (sign_of thy) ty)) thy) (thy,constmaps)
37.11 end)
37.12
37.13 val const_moves = Scan.repeat1 (P.name --| P.$$$ ">" -- P.xname -- Scan.option (P.$$$ "::" |-- P.typ))
37.14 @@ -123,8 +123,8 @@
37.15 let
37.16 val thyname = get_import_thy thy
37.17 in
37.18 - foldl (fn (thy,((hol,isa),None)) => add_hol4_const_mapping thyname hol true isa thy
37.19 - | (thy,((hol,isa),Some ty)) => add_hol4_const_wt_mapping thyname hol true isa (typ_of (read_ctyp (sign_of thy) ty)) thy) (thy,constmaps)
37.20 + foldl (fn (thy,((hol,isa),NONE)) => add_hol4_const_mapping thyname hol true isa thy
37.21 + | (thy,((hol,isa),SOME ty)) => add_hol4_const_wt_mapping thyname hol true isa (typ_of (read_ctyp (sign_of thy) ty)) thy) (thy,constmaps)
37.22 end)
37.23
37.24 fun import_thy s =
37.25 @@ -160,16 +160,16 @@
37.26 then thy
37.27 else
37.28 case ImportData.get thy of
37.29 - None => ImportData.put (Some (fst (Replay.setup_int_thms thyname thy))) thy
37.30 - | Some _ => error "Import data not closed - forgotten an end_setup, mayhap?"
37.31 + NONE => ImportData.put (SOME (fst (Replay.setup_int_thms thyname thy))) thy
37.32 + | SOME _ => error "Import data not closed - forgotten an end_setup, mayhap?"
37.33
37.34 fun clear_int_thms thy =
37.35 if !SkipProof.quick_and_dirty
37.36 then thy
37.37 else
37.38 case ImportData.get thy of
37.39 - None => error "Import data already cleared - forgotten a setup_theory?"
37.40 - | Some _ => ImportData.put None thy
37.41 + NONE => error "Import data already cleared - forgotten a setup_theory?"
37.42 + | SOME _ => ImportData.put NONE thy
37.43
37.44 val setup_theory = P.name
37.45 >>
38.1 --- a/src/HOL/Import/proof_kernel.ML Fri Feb 11 18:51:00 2005 +0100
38.2 +++ b/src/HOL/Import/proof_kernel.ML Sun Feb 13 17:15:14 2005 +0100
38.3 @@ -225,11 +225,11 @@
38.4 end
38.5
38.6 fun disk_info_of (Proof(Info{disk_info,...},_)) = !disk_info
38.7 -fun mk_proof p = Proof(Info{disk_info = ref None},p)
38.8 +fun mk_proof p = Proof(Info{disk_info = ref NONE},p)
38.9 fun content_of (Proof(_,p)) = p
38.10
38.11 fun set_disk_info_of (Proof(Info{disk_info,...},_)) thyname thmname =
38.12 - disk_info := Some(thyname,thmname)
38.13 + disk_info := SOME(thyname,thmname)
38.14
38.15 structure Lib =
38.16 struct
38.17 @@ -307,11 +307,11 @@
38.18 fun F [] toks = (c,toks)
38.19 | F (c::cs) toks =
38.20 case LazySeq.getItem toks of
38.21 - Some(c',toks') =>
38.22 + SOME(c',toks') =>
38.23 if c = c'
38.24 then F cs toks'
38.25 else raise SyntaxError
38.26 - | None => raise SyntaxError
38.27 + | NONE => raise SyntaxError
38.28 in
38.29 F (String.explode str)
38.30 end
38.31 @@ -326,12 +326,12 @@
38.32 in
38.33 fun scan_nonquote toks =
38.34 case LazySeq.getItem toks of
38.35 - Some (c,toks') =>
38.36 + SOME (c,toks') =>
38.37 (case c of
38.38 #"\"" => raise SyntaxError
38.39 | #"&" => scan_entity toks'
38.40 | c => (c,toks'))
38.41 - | None => raise SyntaxError
38.42 + | NONE => raise SyntaxError
38.43 end
38.44
38.45 val scan_string = $$ #"\"" |-- repeat scan_nonquote --| $$ #"\"" >>
38.46 @@ -383,15 +383,15 @@
38.47
38.48 fun intern_const_name thyname const thy =
38.49 case get_hol4_const_mapping thyname const thy of
38.50 - Some (_,cname,_) => cname
38.51 - | None => (case get_hol4_const_renaming thyname const thy of
38.52 - Some cname => Sign.intern_const (sign_of thy) (thyname ^ "." ^ cname)
38.53 - | None => Sign.intern_const (sign_of thy) (thyname ^ "." ^ const))
38.54 + SOME (_,cname,_) => cname
38.55 + | NONE => (case get_hol4_const_renaming thyname const thy of
38.56 + SOME cname => Sign.intern_const (sign_of thy) (thyname ^ "." ^ cname)
38.57 + | NONE => Sign.intern_const (sign_of thy) (thyname ^ "." ^ const))
38.58
38.59 fun intern_type_name thyname const thy =
38.60 case get_hol4_type_mapping thyname const thy of
38.61 - Some (_,cname) => cname
38.62 - | None => Sign.intern_const (sign_of thy) (thyname ^ "." ^ const)
38.63 + SOME (_,cname) => cname
38.64 + | NONE => Sign.intern_const (sign_of thy) (thyname ^ "." ^ const)
38.65
38.66 fun mk_vartype name = TFree(name,["HOL.type"])
38.67 fun mk_thy_type thy Thy Tyop Args = Type(intern_type_name Thy Tyop thy,Args)
38.68 @@ -406,8 +406,8 @@
38.69 local
38.70 fun get_type sg thyname name =
38.71 case Sign.const_type sg name of
38.72 - Some ty => ty
38.73 - | None => raise ERR "get_type" (name ^ ": No such constant")
38.74 + SOME ty => ty
38.75 + | NONE => raise ERR "get_type" (name ^ ": No such constant")
38.76 in
38.77 fun prim_mk_const thy Thy Name =
38.78 let
38.79 @@ -415,7 +415,7 @@
38.80 val cmaps = HOL4ConstMaps.get thy
38.81 in
38.82 case StringPair.lookup(cmaps,(Thy,Name)) of
38.83 - Some(_,_,Some ty) => Const(name,ty)
38.84 + SOME(_,_,SOME ty) => Const(name,ty)
38.85 | _ => Const(name,get_type (sign_of thy) Thy name)
38.86 end
38.87 end
38.88 @@ -511,8 +511,8 @@
38.89 | NONE => raise ERR "get_term_from_index" "Bad index"
38.90 and get_term_from_xml thy thyname types terms =
38.91 let
38.92 - fun get_type [] = None
38.93 - | get_type [ty] = Some (TypeNet.get_type_from_xml thy thyname types ty)
38.94 + fun get_type [] = NONE
38.95 + | get_type [ty] = SOME (TypeNet.get_type_from_xml thy thyname types ty)
38.96 | get_type _ = raise ERR "get_term" "Bad type"
38.97
38.98 fun gtfx (Elem("tmv",[("n",name),("t",tyi)],[])) =
38.99 @@ -566,17 +566,17 @@
38.100 let
38.101 val import_segment =
38.102 case get_segment2 thyname thy of
38.103 - Some seg => seg
38.104 - | None => get_import_segment thy
38.105 + SOME seg => seg
38.106 + | NONE => get_import_segment thy
38.107 val defpath = [OS.Path.joinDirFile {dir=getenv "ISABELLE_HOME_USER",file="proofs"}]
38.108 val path = space_explode ":" (getenv "PROOF_DIRS") @ defpath
38.109 - fun find [] = None
38.110 + fun find [] = NONE
38.111 | find (p::ps) =
38.112 (let
38.113 val dir = OS.Path.joinDirFile {dir = p,file=import_segment}
38.114 in
38.115 if OS.FileSys.isDir dir
38.116 - then Some dir
38.117 + then SOME dir
38.118 else find ps
38.119 end) handle OS.SysErr _ => find ps
38.120 in
38.121 @@ -586,8 +586,8 @@
38.122 fun proof_file_name thyname thmname thy =
38.123 let
38.124 val path = case get_proof_dir thyname thy of
38.125 - Some p => p
38.126 - | None => error "Cannot find proof files"
38.127 + SOME p => p
38.128 + | NONE => error "Cannot find proof files"
38.129 val _ = OS.FileSys.mkDir path handle OS.SysErr _ => ()
38.130 in
38.131 OS.Path.joinDirFile {dir = path, file = OS.Path.joinBaseExt {base = thmname, ext = SOME "prf"}}
38.132 @@ -705,14 +705,14 @@
38.133 val p = x2p prf
38.134 val tml = map xml_to_term tms
38.135 in
38.136 - mk_proof (PGenAbs(p,None,tml))
38.137 + mk_proof (PGenAbs(p,NONE,tml))
38.138 end
38.139 | x2p (Elem("pgenabs",[("i",is)],prf::tms)) =
38.140 let
38.141 val p = x2p prf
38.142 val tml = map xml_to_term tms
38.143 in
38.144 - mk_proof (PGenAbs(p,Some (index_to_term is),tml))
38.145 + mk_proof (PGenAbs(p,SOME (index_to_term is),tml))
38.146 end
38.147 | x2p (Elem("pimpas",[],[prf1,prf2])) =
38.148 let
38.149 @@ -848,8 +848,8 @@
38.150 val terms = TermNet.input_terms thyname types xterms
38.151 in
38.152 (case rest of
38.153 - [] => None
38.154 - | [xtm] => Some (fn thy => TermNet.get_term_from_xml thy thyname types terms xtm)
38.155 + [] => NONE
38.156 + | [xtm] => SOME (fn thy => TermNet.get_term_from_xml thy thyname types terms xtm)
38.157 | _ => raise ERR "import_proof" "Bad argument list",
38.158 xml_to_proof thyname types terms prf)
38.159 end
38.160 @@ -861,10 +861,10 @@
38.161 val res = bicompose false (false,th,m) i st
38.162 in
38.163 case Seq.pull res of
38.164 - Some (th,rest) => (case Seq.pull rest of
38.165 - Some _ => raise ERR "uniq_compose" "Not unique!"
38.166 - | None => th)
38.167 - | None => raise ERR "uniq_compose" "No result"
38.168 + SOME (th,rest) => (case Seq.pull rest of
38.169 + SOME _ => raise ERR "uniq_compose" "Not unique!"
38.170 + | NONE => th)
38.171 + | NONE => raise ERR "uniq_compose" "No result"
38.172 end
38.173
38.174 val reflexivity_thm = thm "refl"
38.175 @@ -932,7 +932,7 @@
38.176 val cvty = ctyp_of_term cv
38.177 val th1 = implies_elim_all th
38.178 val th2 = beta_eta_thm (forall_intr cv th1)
38.179 - val th3 = th2 COMP (beta_eta_thm (Drule.instantiate' [Some cvty] [Some clc] gen_thm))
38.180 + val th3 = th2 COMP (beta_eta_thm (Drule.instantiate' [SOME cvty] [SOME clc] gen_thm))
38.181 val c = prop_of th3
38.182 val vname = fst(dest_Free v)
38.183 val (cold,cnew) = case c of
38.184 @@ -978,8 +978,8 @@
38.185 let
38.186 fun G (ty as TFree _) =
38.187 (case try (Lib.assoc ty) tyinst of
38.188 - Some ty' => ty'
38.189 - | None => ty)
38.190 + SOME ty' => ty'
38.191 + | NONE => ty)
38.192 | G (Type(tyname,tys)) = Type(tyname,map G tys)
38.193 | G (TVar _) = raise ERR "apply_tyinst_typ" "Scematic variable found"
38.194 in
38.195 @@ -1004,8 +1004,8 @@
38.196 fun F (tm as Bound _) = tm
38.197 | F (tm as Free _) =
38.198 (case try (Lib.assoc tm) tminst of
38.199 - Some tm' => tm'
38.200 - | None => tm)
38.201 + SOME tm' => tm'
38.202 + | NONE => tm)
38.203 | F (tm as Const _) = tm
38.204 | F (tm1 $ tm2) = (F tm1) $ (F tm2)
38.205 | F (Abs(vname,ty,body)) = Abs(vname,ty,F body)
38.206 @@ -1045,8 +1045,8 @@
38.207 if v mem vars
38.208 then (vars,rens,inst)
38.209 else (case try (Lib.assoc v) rens of
38.210 - Some vnew => (vars,rens,(v,vnew)::inst)
38.211 - | None => if exists (fn Free(vname',_) => vname = vname' | _ => raise ERR "disamb_helper" "Bad varlist") vars
38.212 + SOME vnew => (vars,rens,(v,vnew)::inst)
38.213 + | NONE => if exists (fn Free(vname',_) => vname = vname' | _ => raise ERR "disamb_helper" "Bad varlist") vars
38.214 then
38.215 let
38.216 val tmnames = map name_of_var varstm
38.217 @@ -1130,10 +1130,10 @@
38.218 foldr (fn((ren as (vold as Free(vname,_),vnew)),
38.219 (rens,inst,vars)) =>
38.220 (case Library.find_first (fn Free(v,_) => v = vname | _ => false) vars of
38.221 - Some v' => if v' = vold
38.222 + SOME v' => if v' = vold
38.223 then (rens,(vnew,vold)::inst,vold::vars)
38.224 else (ren::rens,(vold,vnew)::inst,vnew::vars)
38.225 - | None => (rens,(vnew,vold)::inst,vold::vars))
38.226 + | NONE => (rens,(vnew,vold)::inst,vold::vars))
38.227 | _ => raise ERR "norm_hthm" "Internal error")
38.228 (rens,([],[],vars))
38.229 val (dom,rng) = ListPair.unzip inst
38.230 @@ -1156,14 +1156,14 @@
38.231
38.232 fun get_hol4_thm thyname thmname thy =
38.233 case get_hol4_theorem thyname thmname thy of
38.234 - Some hth => Some (HOLThm hth)
38.235 - | None =>
38.236 + SOME hth => SOME (HOLThm hth)
38.237 + | NONE =>
38.238 let
38.239 val pending = HOL4Pending.get thy
38.240 in
38.241 case StringPair.lookup (pending,(thyname,thmname)) of
38.242 - Some hth => Some (HOLThm hth)
38.243 - | None => None
38.244 + SOME hth => SOME (HOLThm hth)
38.245 + | NONE => NONE
38.246 end
38.247
38.248 fun non_trivial_term_consts tm =
38.249 @@ -1199,10 +1199,10 @@
38.250 val (newstr,u) = apboth Substring.string (Substring.splitr (fn c => c = #"_") f)
38.251 in
38.252 if not (idx = "") andalso u = "_"
38.253 - then Some (newstr,valOf(Int.fromString idx))
38.254 - else None
38.255 + then SOME (newstr,valOf(Int.fromString idx))
38.256 + else NONE
38.257 end
38.258 - handle _ => None
38.259 + handle _ => NONE
38.260
38.261 fun rewrite_hol4_term t thy =
38.262 let
38.263 @@ -1233,25 +1233,25 @@
38.264 fun mk_res th = HOLThm(rens_of info,equal_elim i2h_conc th)
38.265 in
38.266 case get_hol4_mapping thyname thmname thy of
38.267 - Some (Some thmname) =>
38.268 + SOME (SOME thmname) =>
38.269 let
38.270 val _ = message ("Looking for " ^ thmname)
38.271 - val th1 = (Some (transform_error (PureThy.get_thm thy) (thmname, None))
38.272 + val th1 = (SOME (transform_error (PureThy.get_thm thy) (thmname, NONE))
38.273 handle ERROR_MESSAGE _ =>
38.274 (case split_name thmname of
38.275 - Some (listname,idx) => (Some (nth_elem(idx-1,PureThy.get_thms thy (listname, None)))
38.276 - handle _ => None)
38.277 - | None => None))
38.278 + SOME (listname,idx) => (SOME (nth_elem(idx-1,PureThy.get_thms thy (listname, NONE)))
38.279 + handle _ => NONE)
38.280 + | NONE => NONE))
38.281 in
38.282 case th1 of
38.283 - Some th2 =>
38.284 + SOME th2 =>
38.285 (case Shuffler.set_prop thy isaconc [(thmname,th2)] of
38.286 - Some (_,th) => (message "YES";(thy, Some (mk_res th)))
38.287 - | None => (message "NO2";error "get_isabelle_thm" "Bad mapping"))
38.288 - | None => (message "NO1";error "get_isabelle_thm" "Bad mapping")
38.289 + SOME (_,th) => (message "YES";(thy, SOME (mk_res th)))
38.290 + | NONE => (message "NO2";error "get_isabelle_thm" "Bad mapping"))
38.291 + | NONE => (message "NO1";error "get_isabelle_thm" "Bad mapping")
38.292 end
38.293 - | Some None => error ("Trying to access ignored theorem " ^ thmname)
38.294 - | None =>
38.295 + | SOME NONE => error ("Trying to access ignored theorem " ^ thmname)
38.296 + | NONE =>
38.297 let
38.298 val _ = (message "Looking for conclusion:";
38.299 if_debug prin isaconc)
38.300 @@ -1262,32 +1262,32 @@
38.301 val _ = message ((Int.toString (length pot_thms)) ^ " potential theorems")
38.302 in
38.303 case Shuffler.set_prop thy isaconc pot_thms of
38.304 - Some (isaname,th) =>
38.305 + SOME (isaname,th) =>
38.306 let
38.307 val hth as HOLThm args = mk_res th
38.308 val thy' = thy |> add_hol4_theorem thyname thmname args
38.309 |> add_hol4_mapping thyname thmname isaname
38.310 in
38.311 - (thy',Some hth)
38.312 + (thy',SOME hth)
38.313 end
38.314 - | None => (thy,None)
38.315 + | NONE => (thy,NONE)
38.316 end
38.317 end
38.318 - handle _ => (thy,None)
38.319 + handle _ => (thy,NONE)
38.320
38.321 fun get_thm thyname thmname thy =
38.322 case get_hol4_thm thyname thmname thy of
38.323 - Some hth => (thy,Some hth)
38.324 - | None => ((case fst (import_proof thyname thmname thy) of
38.325 - Some f => get_isabelle_thm thyname thmname (f thy) thy
38.326 - | None => (thy,None))
38.327 - handle e as IO.Io _ => (thy,None)
38.328 - | e as PK _ => (thy,None))
38.329 + SOME hth => (thy,SOME hth)
38.330 + | NONE => ((case fst (import_proof thyname thmname thy) of
38.331 + SOME f => get_isabelle_thm thyname thmname (f thy) thy
38.332 + | NONE => (thy,NONE))
38.333 + handle e as IO.Io _ => (thy,NONE)
38.334 + | e as PK _ => (thy,NONE))
38.335
38.336 fun rename_const thyname thy name =
38.337 case get_hol4_const_renaming thyname name thy of
38.338 - Some cname => cname
38.339 - | None => name
38.340 + SOME cname => cname
38.341 + | NONE => name
38.342
38.343 fun get_def thyname constname rhs thy =
38.344 let
38.345 @@ -1300,7 +1300,7 @@
38.346
38.347 fun get_axiom thyname axname thy =
38.348 case get_thm thyname axname thy of
38.349 - arg as (_,Some _) => arg
38.350 + arg as (_,SOME _) => arg
38.351 | _ => raise ERR "get_axiom" ("Trying to retrieve axiom (" ^ axname ^ ")")
38.352
38.353 fun intern_store_thm gen_output thyname thmname hth thy =
38.354 @@ -1325,7 +1325,7 @@
38.355 let
38.356 val cty = Thm.ctyp_of_term ctm
38.357 in
38.358 - Drule.instantiate' [Some cty] [Some ctm] reflexivity_thm
38.359 + Drule.instantiate' [SOME cty] [SOME ctm] reflexivity_thm
38.360 end
38.361
38.362 fun REFL tm thy =
38.363 @@ -1363,8 +1363,8 @@
38.364 val tys_after = add_term_tvars (prop_of th1,[])
38.365 val tyinst = map (fn (bef,(i,_)) =>
38.366 (case try (Lib.assoc (TFree bef)) lambda of
38.367 - Some ty => (i,ctyp_of sg ty)
38.368 - | None => (i,ctyp_of sg (TFree bef))
38.369 + SOME ty => (i,ctyp_of sg ty)
38.370 + | NONE => (i,ctyp_of sg (TFree bef))
38.371 ))
38.372 (zip tys_before tys_after)
38.373 val res = Drule.instantiate (tyinst,[]) th1
38.374 @@ -1433,9 +1433,9 @@
38.375 val fty = type_of f
38.376 val (fd,fr) = dom_rng fty
38.377 val comb_thm' = Drule.instantiate'
38.378 - [Some (ctyp_of sg fd),Some (ctyp_of sg fr)]
38.379 - [Some (cterm_of sg f),Some (cterm_of sg g),
38.380 - Some (cterm_of sg x),Some (cterm_of sg y)] comb_thm
38.381 + [SOME (ctyp_of sg fd),SOME (ctyp_of sg fr)]
38.382 + [SOME (cterm_of sg f),SOME (cterm_of sg g),
38.383 + SOME (cterm_of sg x),SOME (cterm_of sg y)] comb_thm
38.384 in
38.385 [th1,th2] MRS comb_thm'
38.386 end
38.387 @@ -1495,7 +1495,7 @@
38.388 val (info',tm') = disamb_term_from info tm
38.389 val sg = sign_of thy
38.390 val ct = Thm.cterm_of sg tm'
38.391 - val disj1_thm' = Drule.instantiate' [] [None,Some ct] disj1_thm
38.392 + val disj1_thm' = Drule.instantiate' [] [NONE,SOME ct] disj1_thm
38.393 val res = HOLThm(rens_of info',th RS disj1_thm')
38.394 val _ = message "RESULT:"
38.395 val _ = if_debug pth res
38.396 @@ -1512,7 +1512,7 @@
38.397 val (info',tm') = disamb_term_from info tm
38.398 val sg = sign_of thy
38.399 val ct = Thm.cterm_of sg tm'
38.400 - val disj2_thm' = Drule.instantiate' [] [None,Some ct] disj2_thm
38.401 + val disj2_thm' = Drule.instantiate' [] [NONE,SOME ct] disj2_thm
38.402 val res = HOLThm(rens_of info',th RS disj2_thm')
38.403 val _ = message "RESULT:"
38.404 val _ = if_debug pth res
38.405 @@ -1611,7 +1611,7 @@
38.406 (Const("Ex",_) $ a) => a
38.407 | _ => raise ERR "EXISTS" "Argument not existential"
38.408 val ca = cterm_of sg a
38.409 - val exists_thm' = beta_eta_thm (Drule.instantiate' [Some cty] [Some ca,Some cwit] exists_thm)
38.410 + val exists_thm' = beta_eta_thm (Drule.instantiate' [SOME cty] [SOME ca,SOME cwit] exists_thm)
38.411 val th1 = beta_eta_thm th
38.412 val th2 = implies_elim_all th1
38.413 val th3 = th2 COMP exists_thm'
38.414 @@ -1645,7 +1645,7 @@
38.415 _ $ (Const("Ex",_) $ a) => a
38.416 | _ => raise ERR "CHOOSE" "Conclusion not existential"
38.417 val ca = cterm_of (sign_of_thm th1) a
38.418 - val choose_thm' = beta_eta_thm (Drule.instantiate' [Some cvty] [Some ca,Some cc] choose_thm)
38.419 + val choose_thm' = beta_eta_thm (Drule.instantiate' [SOME cvty] [SOME ca,SOME cc] choose_thm)
38.420 val th21 = rearrange sg (HOLogic.mk_Trueprop (a $ v')) th2
38.421 val th22 = strip ((nprems_of th21)-1) (cprems_of th21) th21
38.422 val th23 = beta_eta_thm (forall_intr cv th22)
38.423 @@ -1683,7 +1683,7 @@
38.424 val sg = sign_of thy
38.425 val ctm = Thm.cterm_of sg tm'
38.426 val cty = Thm.ctyp_of_term ctm
38.427 - val spec' = Drule.instantiate' [Some cty] [None,Some ctm] spec_thm
38.428 + val spec' = Drule.instantiate' [SOME cty] [NONE,SOME ctm] spec_thm
38.429 val th = th RS spec'
38.430 val res = HOLThm(rens_of info',th)
38.431 val _ = message "RESULT:"
38.432 @@ -1732,7 +1732,7 @@
38.433 val sg = sign_of thy
38.434 val ct = cterm_of sg tm'
38.435 val th1 = rearrange sg (HOLogic.mk_Trueprop (Const("Not",boolT-->boolT) $ tm')) th
38.436 - val ccontr_thm' = Drule.instantiate' [] [Some ct] ccontr_thm
38.437 + val ccontr_thm' = Drule.instantiate' [] [SOME ct] ccontr_thm
38.438 val res1 = uniq_compose ((nprems_of th1) - 1) th1 1 ccontr_thm'
38.439 val res = HOLThm(rens_of info',res1)
38.440 val _ = message "RESULT:"
38.441 @@ -1749,7 +1749,7 @@
38.442 _ $ (Const("op =",_) $ f $ g) => (Term.lambda v f,Term.lambda v g)
38.443 | _ => raise ERR "mk_ABS" "Bad conclusion"
38.444 val (fd,fr) = dom_rng (type_of f)
38.445 - val abs_thm' = Drule.instantiate' [Some (ctyp_of sg fd), Some (ctyp_of sg fr)] [Some (cterm_of sg f), Some (cterm_of sg g)] abs_thm
38.446 + val abs_thm' = Drule.instantiate' [SOME (ctyp_of sg fd), SOME (ctyp_of sg fr)] [SOME (cterm_of sg f), SOME (cterm_of sg g)] abs_thm
38.447 val th2 = forall_intr cv th1
38.448 val th3 = th2 COMP abs_thm'
38.449 val res = implies_intr_hyps th3
38.450 @@ -1776,8 +1776,8 @@
38.451 let
38.452 val _ = message "GEN_ABS:"
38.453 val _ = case copt of
38.454 - Some c => if_debug prin c
38.455 - | None => ()
38.456 + SOME c => if_debug prin c
38.457 + | NONE => ()
38.458 val _ = if_debug (app prin) vlist
38.459 val _ = if_debug pth hth
38.460 val (info,th) = disamb_thm hth
38.461 @@ -1785,7 +1785,7 @@
38.462 val sg = sign_of thy
38.463 val th1 =
38.464 case copt of
38.465 - Some (c as Const(cname,cty)) =>
38.466 + SOME (c as Const(cname,cty)) =>
38.467 let
38.468 fun inst_type ty1 ty2 (TVar _) = raise ERR "GEN_ABS" "Type variable found!"
38.469 | inst_type ty1 ty2 (ty as TFree _) = if ty1 = ty
38.470 @@ -1804,8 +1804,8 @@
38.471 mk_COMB (mk_REFL cc) (mk_ABS v th sg) sg
38.472 end) (vlist',th)
38.473 end
38.474 - | Some _ => raise ERR "GEN_ABS" "Bad constant"
38.475 - | None =>
38.476 + | SOME _ => raise ERR "GEN_ABS" "Bad constant"
38.477 + | NONE =>
38.478 foldr (fn (v,th) => mk_ABS v th sg) (vlist',th)
38.479 val res = HOLThm(rens_of info',th1)
38.480 val _ = message "RESULT:"
38.481 @@ -1824,7 +1824,7 @@
38.482 _ $ (Const("op -->",_) $ a $ Const("False",_)) => a
38.483 | _ => raise ERR "NOT_INTRO" "Conclusion of bad form"
38.484 val ca = cterm_of sg a
38.485 - val th2 = equal_elim (Drule.instantiate' [] [Some ca] not_intro_thm) th1
38.486 + val th2 = equal_elim (Drule.instantiate' [] [SOME ca] not_intro_thm) th1
38.487 val res = HOLThm(rens,implies_intr_hyps th2)
38.488 val _ = message "RESULT:"
38.489 val _ = if_debug pth res
38.490 @@ -1842,7 +1842,7 @@
38.491 _ $ (Const("Not",_) $ a) => a
38.492 | _ => raise ERR "NOT_ELIM" "Conclusion of bad form"
38.493 val ca = cterm_of sg a
38.494 - val th2 = equal_elim (Drule.instantiate' [] [Some ca] not_elim_thm) th1
38.495 + val th2 = equal_elim (Drule.instantiate' [] [SOME ca] not_elim_thm) th1
38.496 val res = HOLThm(rens,implies_intr_hyps th2)
38.497 val _ = message "RESULT:"
38.498 val _ = if_debug pth res
38.499 @@ -1905,8 +1905,8 @@
38.500 thy''
38.501
38.502 val hth = case Shuffler.set_prop thy22 (HOLogic.mk_Trueprop tm24) [("",th)] of
38.503 - Some (_,res) => HOLThm(rens_of linfo,res)
38.504 - | None => raise ERR "new_definition" "Bad conclusion"
38.505 + SOME (_,res) => HOLThm(rens_of linfo,res)
38.506 + | NONE => raise ERR "new_definition" "Bad conclusion"
38.507 val fullname = Sign.full_name sg thmname
38.508 val thy22' = case opt_get_output_thy thy22 of
38.509 "" => add_hol4_mapping thyname thmname fullname thy22
38.510 @@ -1973,7 +1973,7 @@
38.511 val thy1 = foldr (fn(name,thy)=>
38.512 snd (get_defname thyname name thy)) (names,thy1)
38.513 fun new_name name = fst (get_defname thyname name thy1)
38.514 - val (thy',res) = SpecificationPackage.add_specification_i None
38.515 + val (thy',res) = SpecificationPackage.add_specification_i NONE
38.516 (map (fn name => (new_name name,name,false)) names)
38.517 (thy1,th)
38.518 val res' = Drule.freeze_all res
38.519 @@ -2041,7 +2041,7 @@
38.520 val tnames = map fst tfrees
38.521 val tsyn = mk_syn thy tycname
38.522 val typ = (tycname,tnames,tsyn)
38.523 - val (thy',typedef_info) = TypedefPackage.add_typedef_i false (Some thmname) typ c None (rtac th2 1) thy
38.524 + val (thy',typedef_info) = TypedefPackage.add_typedef_i false (SOME thmname) typ c NONE (rtac th2 1) thy
38.525
38.526 val th3 = (#type_definition typedef_info) RS typedef_hol2hol4
38.527
38.528 @@ -2093,9 +2093,9 @@
38.529 val sg = sign_of thy
38.530 val tT = type_of t
38.531 val light_nonempty' =
38.532 - Drule.instantiate' [Some (ctyp_of sg tT)]
38.533 - [Some (cterm_of sg P),
38.534 - Some (cterm_of sg t)] light_nonempty
38.535 + Drule.instantiate' [SOME (ctyp_of sg tT)]
38.536 + [SOME (cterm_of sg P),
38.537 + SOME (cterm_of sg t)] light_nonempty
38.538 val th2 = beta_eta_thm (td_th RS (beta_eta_thm light_nonempty'))
38.539 val c = case concl_of th2 of
38.540 _ $ (Const("Ex",_) $ Abs(_,_,Const("op :",_) $ _ $ c)) => c
38.541 @@ -2104,7 +2104,7 @@
38.542 val tnames = map fst tfrees
38.543 val tsyn = mk_syn thy tycname
38.544 val typ = (tycname,tnames,tsyn)
38.545 - val (thy',typedef_info) = TypedefPackage.add_typedef_i false (Some thmname) typ c (Some(rep_name,abs_name)) (rtac th2 1) thy
38.546 + val (thy',typedef_info) = TypedefPackage.add_typedef_i false (SOME thmname) typ c (SOME(rep_name,abs_name)) (rtac th2 1) thy
38.547
38.548 val th3 = (#type_definition typedef_info) RS typedef_hol2hollight
38.549
39.1 --- a/src/HOL/Import/replay.ML Fri Feb 11 18:51:00 2005 +0100
39.2 +++ b/src/HOL/Import/replay.ML Sun Feb 13 17:15:14 2005 +0100
39.3 @@ -57,8 +57,8 @@
39.4 | rp (PHyp tm) thy = P.ASSUME tm thy
39.5 | rp (PDef(seg,name,rhs)) thy =
39.6 (case P.get_def seg name rhs thy of
39.7 - (thy',Some res) => (thy',res)
39.8 - | (thy',None) =>
39.9 + (thy',SOME res) => (thy',res)
39.10 + | (thy',NONE) =>
39.11 if seg = thyname
39.12 then P.new_definition seg name rhs thy'
39.13 else raise ERR "replay_proof" "Too late for term definition")
39.14 @@ -208,25 +208,25 @@
39.15 in
39.16 case pc of
39.17 PDisk => (case disk_info_of p of
39.18 - Some(thyname',thmname) =>
39.19 + SOME(thyname',thmname) =>
39.20 (case Int.fromString thmname of
39.21 SOME i =>
39.22 if thyname' = thyname
39.23 then
39.24 (case Array.sub(int_thms,i-1) of
39.25 - None =>
39.26 + NONE =>
39.27 let
39.28 val (thy',th) = rp' (snd (import_proof thyname' thmname thy) thy) thy
39.29 - val _ = Array.update(int_thms,i-1,Some th)
39.30 + val _ = Array.update(int_thms,i-1,SOME th)
39.31 in
39.32 (thy',th)
39.33 end
39.34 - | Some th => (thy,th))
39.35 + | SOME th => (thy,th))
39.36 else raise ERR "replay_proof" ("Library " ^ thyname' ^ " should be built before " ^ thyname ^ " (" ^ thmname ^ ")")
39.37 | NONE =>
39.38 (case P.get_thm thyname' thmname thy of
39.39 - (thy',Some res) => (thy',res)
39.40 - | (thy',None) =>
39.41 + (thy',SOME res) => (thy',res)
39.42 + | (thy',NONE) =>
39.43 if thyname' = thyname
39.44 then
39.45 let
39.46 @@ -242,11 +242,11 @@
39.47 | _ => P.store_thm thyname' thmname th thy'
39.48 end
39.49 else raise ERR "replay_proof" ("Library " ^ thyname' ^ " should be built before " ^ thyname ^ " (" ^ thmname ^ ")")))
39.50 - | None => raise ERR "rp'.PDisk" "Not enough information")
39.51 + | NONE => raise ERR "rp'.PDisk" "Not enough information")
39.52 | PAxm(name,c) =>
39.53 (case P.get_axiom thyname name thy of
39.54 - (thy',Some res) => (thy',res)
39.55 - | (thy',None) => P.new_axiom name c thy')
39.56 + (thy',SOME res) => (thy',res)
39.57 + | (thy',NONE) => P.new_axiom name c thy')
39.58 | PTmSpec(seg,names,prf') =>
39.59 let
39.60 val (thy',th) = rp' prf' thy
39.61 @@ -275,8 +275,8 @@
39.62 let
39.63 val fname =
39.64 case P.get_proof_dir thyname thy of
39.65 - Some p => OS.Path.joinDirFile {dir=p,file=OS.Path.joinBaseExt{base = "facts",ext=SOME "lst"}}
39.66 - | None => error "Cannot find proof files"
39.67 + SOME p => OS.Path.joinDirFile {dir=p,file=OS.Path.joinBaseExt{base = "facts",ext=SOME "lst"}}
39.68 + | NONE => error "Cannot find proof files"
39.69 val is = TextIO.openIn fname
39.70 val (num_int_thms,facts) =
39.71 let
39.72 @@ -290,7 +290,7 @@
39.73 get_facts []
39.74 end
39.75 val _ = TextIO.closeIn is
39.76 - val int_thms = Array.array(num_int_thms,None:thm option)
39.77 + val int_thms = Array.array(num_int_thms,NONE:thm option)
39.78 in
39.79 (int_thms,facts)
39.80 end
40.1 --- a/src/HOL/Import/shuffler.ML Fri Feb 11 18:51:00 2005 +0100
40.2 +++ b/src/HOL/Import/shuffler.ML Sun Feb 13 17:15:14 2005 +0100
40.3 @@ -231,7 +231,7 @@
40.4 val res = (find_bound 0 body;2) handle RESULT i => i
40.5 in
40.6 case res of
40.7 - 0 => Some (rew_th sg (x,xT) (y,yT) body)
40.8 + 0 => SOME (rew_th sg (x,xT) (y,yT) body)
40.9 | 1 => if string_ord(y,x) = LESS
40.10 then
40.11 let
40.12 @@ -239,12 +239,12 @@
40.13 val t_th = reflexive (cterm_of sg t)
40.14 val newt_th = reflexive (cterm_of sg newt)
40.15 in
40.16 - Some (transitive t_th newt_th)
40.17 + SOME (transitive t_th newt_th)
40.18 end
40.19 - else None
40.20 + else NONE
40.21 | _ => error "norm_term (quant_rewrite) internal error"
40.22 end
40.23 - | quant_rewrite _ _ _ = (warning "quant_rewrite: Unknown lhs"; None)
40.24 + | quant_rewrite _ _ _ = (warning "quant_rewrite: Unknown lhs"; NONE)
40.25
40.26 fun freeze_thaw_term t =
40.27 let
40.28 @@ -304,7 +304,7 @@
40.29 val lhs = #1 (Logic.dest_equals (prop_of (final init)))
40.30 in
40.31 if not (lhs aconv origt)
40.32 - then (writeln "Something is utterly wrong: (orig,lhs,frozen type,t,tinst)";
40.33 + then (writeln "SOMEthing is utterly wrong: (orig,lhs,frozen type,t,tinst)";
40.34 writeln (string_of_cterm (cterm_of sg origt));
40.35 writeln (string_of_cterm (cterm_of sg lhs));
40.36 writeln (string_of_cterm (cterm_of sg typet));
40.37 @@ -338,15 +338,15 @@
40.38 val res = final rew_th
40.39 val lhs = (#1 (Logic.dest_equals (prop_of res)))
40.40 in
40.41 - Some res
40.42 + SOME res
40.43 end
40.44 - else None)
40.45 + else NONE)
40.46 handle e => (writeln "eta_contract:";print_exn e))
40.47 - | _ => (error ("Bad eta_contract argument" ^ (string_of_cterm (cterm_of sg t))); None)
40.48 + | _ => (error ("Bad eta_contract argument" ^ (string_of_cterm (cterm_of sg t))); NONE)
40.49 end
40.50
40.51 fun beta_fun sg assume t =
40.52 - Some (beta_conversion true (cterm_of sg t))
40.53 + SOME (beta_conversion true (cterm_of sg t))
40.54
40.55 fun eta_expand sg assumes origt =
40.56 let
40.57 @@ -359,7 +359,7 @@
40.58 val lhs = #1 (Logic.dest_equals (prop_of (final init)))
40.59 in
40.60 if not (lhs aconv origt)
40.61 - then (writeln "Something is utterly wrong: (orig,lhs,frozen type,t,tinst)";
40.62 + then (writeln "SOMEthing is utterly wrong: (orig,lhs,frozen type,t,tinst)";
40.63 writeln (string_of_cterm (cterm_of sg origt));
40.64 writeln (string_of_cterm (cterm_of sg lhs));
40.65 writeln (string_of_cterm (cterm_of sg typet));
40.66 @@ -396,11 +396,11 @@
40.67 val res = equal_intr th1 (th2' |> implies_intr concl)
40.68 val res' = final res
40.69 in
40.70 - Some res'
40.71 + SOME res'
40.72 end
40.73 - | _ => None)
40.74 - else None
40.75 - | _ => (error ("Bad eta_expand argument" ^ (string_of_cterm (cterm_of sg t))); None)
40.76 + | _ => NONE)
40.77 + else NONE
40.78 + | _ => (error ("Bad eta_expand argument" ^ (string_of_cterm (cterm_of sg t))); NONE)
40.79 end
40.80 handle e => (writeln "eta_expand internal error";print_exn e)
40.81
40.82 @@ -519,19 +519,19 @@
40.83 end
40.84
40.85 (* make_equal sg t u tries to construct the theorem t == u under the
40.86 -signature sg. If it succeeds, Some (t == u) is returned, otherwise
40.87 -None is returned. *)
40.88 +signature sg. If it succeeds, SOME (t == u) is returned, otherwise
40.89 +NONE is returned. *)
40.90
40.91 fun make_equal sg t u =
40.92 let
40.93 val t_is_t' = norm_term sg t
40.94 val u_is_u' = norm_term sg u
40.95 val th = transitive t_is_t' (symmetric u_is_u')
40.96 - val _ = message ("make_equal: Some " ^ (string_of_thm th))
40.97 + val _ = message ("make_equal: SOME " ^ (string_of_thm th))
40.98 in
40.99 - Some th
40.100 + SOME th
40.101 end
40.102 - handle e as THM _ => (message "make_equal: None";None)
40.103 + handle e as THM _ => (message "make_equal: NONE";NONE)
40.104
40.105 fun match_consts ignore t (* th *) =
40.106 let
40.107 @@ -564,7 +564,7 @@
40.108
40.109 (* set_prop t thms tries to make a theorem with the proposition t from
40.110 one of the theorems thms, by shuffling the propositions around. If it
40.111 -succeeds, Some theorem is returned, otherwise None. *)
40.112 +succeeds, SOME theorem is returned, otherwise NONE. *)
40.113
40.114 fun set_prop thy t =
40.115 let
40.116 @@ -576,34 +576,34 @@
40.117 val rhs = snd (dest_equals (cprop_of rew_th))
40.118
40.119 val shuffles = ShuffleData.get thy
40.120 - fun process [] = None
40.121 + fun process [] = NONE
40.122 | process ((name,th)::thms) =
40.123 let
40.124 val norm_th = varifyT (norm_thm thy (close_thm (transfer_sg sg th)))
40.125 val triv_th = trivial rhs
40.126 val _ = message ("Shuffler.set_prop: Gluing together " ^ (string_of_thm norm_th) ^ " and " ^ (string_of_thm triv_th))
40.127 val mod_th = case Seq.pull (bicompose true (false,norm_th,0) 1 triv_th) of
40.128 - Some(th,_) => Some th
40.129 - | None => None
40.130 + SOME(th,_) => SOME th
40.131 + | NONE => NONE
40.132 in
40.133 case mod_th of
40.134 - Some mod_th =>
40.135 + SOME mod_th =>
40.136 let
40.137 val closed_th = equal_elim (symmetric rew_th) mod_th
40.138 in
40.139 message ("Shuffler.set_prop succeeded by " ^ name);
40.140 - Some (name,forall_elim_list (map (cterm_of sg) vars) closed_th)
40.141 + SOME (name,forall_elim_list (map (cterm_of sg) vars) closed_th)
40.142 end
40.143 - | None => process thms
40.144 + | NONE => process thms
40.145 end
40.146 handle e as THM _ => process thms
40.147 in
40.148 fn thms =>
40.149 case process thms of
40.150 - res as Some (name,th) => if (prop_of th) aconv t
40.151 + res as SOME (name,th) => if (prop_of th) aconv t
40.152 then res
40.153 else error "Internal error in set_prop"
40.154 - | None => None
40.155 + | NONE => NONE
40.156 end
40.157 handle e => (writeln "set_prop internal error"; print_exn e)
40.158
40.159 @@ -624,8 +624,8 @@
40.160 val set = set_prop thy t
40.161 fun process_tac thms st =
40.162 case set thms of
40.163 - Some (_,th) => Seq.of_list (compose (th,i,st))
40.164 - | None => Seq.empty
40.165 + SOME (_,th) => Seq.of_list (compose (th,i,st))
40.166 + | NONE => Seq.empty
40.167 in
40.168 (process_tac thms APPEND (if search
40.169 then process_tac (find_potential thy t)
41.1 --- a/src/HOL/Integ/NatBin.thy Fri Feb 11 18:51:00 2005 +0100
41.2 +++ b/src/HOL/Integ/NatBin.thy Sun Feb 13 17:15:14 2005 +0100
41.3 @@ -859,14 +859,14 @@
41.4 ML {*
41.5 fun number_of_codegen thy gr s b (Const ("Numeral.number_of",
41.6 Type ("fun", [_, Type ("IntDef.int", [])])) $ bin) =
41.7 - (Some (gr, Pretty.str (string_of_int (HOLogic.dest_binum bin)))
41.8 - handle TERM _ => None)
41.9 + (SOME (gr, Pretty.str (string_of_int (HOLogic.dest_binum bin)))
41.10 + handle TERM _ => NONE)
41.11 | number_of_codegen thy gr s b (Const ("Numeral.number_of",
41.12 Type ("fun", [_, Type ("nat", [])])) $ bin) =
41.13 - Some (Codegen.invoke_codegen thy s b (gr,
41.14 + SOME (Codegen.invoke_codegen thy s b (gr,
41.15 Const ("IntDef.nat", HOLogic.intT --> HOLogic.natT) $
41.16 (Const ("Numeral.number_of", HOLogic.binT --> HOLogic.intT) $ bin)))
41.17 - | number_of_codegen _ _ _ _ _ = None;
41.18 + | number_of_codegen _ _ _ _ _ = NONE;
41.19 *}
41.20
41.21 setup {* [Codegen.add_codegen "number_of_codegen" number_of_codegen] *}
42.1 --- a/src/HOL/Integ/cooper_dec.ML Fri Feb 11 18:51:00 2005 +0100
42.2 +++ b/src/HOL/Integ/cooper_dec.ML Sun Feb 13 17:15:14 2005 +0100
42.3 @@ -92,7 +92,7 @@
42.4 fun dest_numeral (Const("0",Type ("IntDef.int", []))) = 0
42.5 |dest_numeral (Const("1",Type ("IntDef.int", []))) = 1
42.6 |dest_numeral (Const ("Numeral.number_of",_) $ n)= HOLogic.dest_binum n;
42.7 -(*Some terms often used for pattern matching*)
42.8 +(*SOME terms often used for pattern matching*)
42.9
42.10 val zero = mk_numeral 0;
42.11 val one = mk_numeral 1;
42.12 @@ -450,7 +450,7 @@
42.13 [("op =",op=), ("op <",op<), ("op >",op>), ("op <=",op<=) , ("op >=",op>=),
42.14 ("Divides.op dvd",fn (x,y) =>((y mod x) = 0))];
42.15
42.16 -fun applyoperation (Some f) (a,b) = f (a, b)
42.17 +fun applyoperation (SOME f) (a,b) = f (a, b)
42.18 |applyoperation _ (_, _) = false;
42.19
42.20 (*Evaluation of constant atomic formulas*)
42.21 @@ -464,12 +464,12 @@
42.22 handle _ => at)
42.23 else
42.24 case assoc (operations,p) of
42.25 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
42.26 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
42.27 handle _ => at)
42.28 | _ => at)
42.29 |Const("Not",_)$(Const (p,_) $ s $ t) =>(
42.30 case assoc (operations,p) of
42.31 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then
42.32 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then
42.33 HOLogic.false_const else HOLogic.true_const)
42.34 handle _ => at)
42.35 | _ => at)
42.36 @@ -480,12 +480,12 @@
42.37 fun evalc_atom at = case at of
42.38 (Const (p,_) $ s $ t) =>
42.39 ( case assoc (operations,p) of
42.40 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
42.41 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
42.42 handle _ => at)
42.43 | _ => at)
42.44 |Const("Not",_)$(Const (p,_) $ s $ t) =>(
42.45 case assoc (operations,p) of
42.46 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then
42.47 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then
42.48 HOLogic.false_const else HOLogic.true_const)
42.49 handle _ => at)
42.50 | _ => at)
42.51 @@ -711,14 +711,14 @@
42.52 fun inf_w mi d vars x p =
42.53 let val f = if mi then minusinf else plusinf in
42.54 case (simpl (minusinf x p)) of
42.55 - Const("True",_) => (Some (mk_numeral 1), HOLogic.true_const)
42.56 - |Const("False",_) => (None,HOLogic.false_const)
42.57 + Const("True",_) => (SOME (mk_numeral 1), HOLogic.true_const)
42.58 + |Const("False",_) => (NONE,HOLogic.false_const)
42.59 |F =>
42.60 let
42.61 fun h n =
42.62 case ((simpl o evalc) (linrep vars x (mk_numeral n) F)) of
42.63 - Const("True",_) => (Some (mk_numeral n),HOLogic.true_const)
42.64 - |F' => if n=1 then (None,F')
42.65 + Const("True",_) => (SOME (mk_numeral n),HOLogic.true_const)
42.66 + |F' => if n=1 then (NONE,F')
42.67 else let val (rw,rf) = h (n-1) in
42.68 (rw,HOLogic.mk_disj(F',rf))
42.69 end
42.70 @@ -729,9 +729,9 @@
42.71
42.72 fun set_w d b st vars x p = let
42.73 fun h ns = case ns of
42.74 - [] => (None,HOLogic.false_const)
42.75 + [] => (NONE,HOLogic.false_const)
42.76 |n::nl => ( case ((simpl o evalc) (linrep vars x n p)) of
42.77 - Const("True",_) => (Some n,HOLogic.true_const)
42.78 + Const("True",_) => (SOME n,HOLogic.true_const)
42.79 |F' => let val (rw,rf) = h nl
42.80 in (rw,HOLogic.mk_disj(F',rf))
42.81 end)
42.82 @@ -741,10 +741,10 @@
42.83 end;
42.84
42.85 fun withness d b st vars x p = case (inf_w b d vars x p) of
42.86 - (Some n,_) => (Some n,HOLogic.true_const)
42.87 - |(None,Pinf) => (case (set_w d b st vars x p) of
42.88 - (Some n,_) => (Some n,HOLogic.true_const)
42.89 - |(_,Pst) => (None,HOLogic.mk_disj(Pinf,Pst)));
42.90 + (SOME n,_) => (SOME n,HOLogic.true_const)
42.91 + |(NONE,Pinf) => (case (set_w d b st vars x p) of
42.92 + (SOME n,_) => (SOME n,HOLogic.true_const)
42.93 + |(_,Pst) => (NONE,HOLogic.mk_disj(Pinf,Pst)));
42.94
42.95
42.96
43.1 --- a/src/HOL/Integ/cooper_proof.ML Fri Feb 11 18:51:00 2005 +0100
43.2 +++ b/src/HOL/Integ/cooper_proof.ML Sun Feb 13 17:15:14 2005 +0100
43.3 @@ -194,8 +194,8 @@
43.4
43.5 fun simple_prove_goal_cterm2 G tacs =
43.6 let
43.7 - fun check None = error "prove_goal: tactic failed"
43.8 - | check (Some (thm, _)) = (case nprems_of thm of
43.9 + fun check NONE = error "prove_goal: tactic failed"
43.10 + | check (SOME (thm, _)) = (case nprems_of thm of
43.11 0 => thm
43.12 | i => !result_error_fn thm (string_of_int i ^ " unsolved goals!"))
43.13 in check (Seq.pull (EVERY tacs (trivial G))) end;
43.14 @@ -320,7 +320,7 @@
43.15 val cx = cterm_of sg y
43.16 val pre = prove_elementar sg "lf"
43.17 (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),(mk_numeral n)))
43.18 - val th1 = (pre RS (instantiate' [] [Some ck,Some cc, Some cx, Some ct] (ac_pi_eq)))
43.19 + val th1 = (pre RS (instantiate' [] [SOME ck,SOME cc, SOME cx, SOME ct] (ac_pi_eq)))
43.20 in ([], fn [] => [th1,(prove_elementar sg "sa" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
43.21 end
43.22
43.23 @@ -344,32 +344,32 @@
43.24 "op <" =>
43.25 let val pre = prove_elementar sg "lf"
43.26 (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),(mk_numeral k)))
43.27 - val th1 = (pre RS (instantiate' [] [Some ck,Some ca,Some cc, Some cx, Some ct] (ac_lt_eq)))
43.28 + val th1 = (pre RS (instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct] (ac_lt_eq)))
43.29 in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
43.30 end
43.31
43.32 |"op =" =>
43.33 let val pre = prove_elementar sg "lf"
43.34 (HOLogic.Not $ (HOLogic.mk_binrel "op =" (Const("0",HOLogic.intT),(mk_numeral k))))
43.35 - val th1 = (pre RS(instantiate' [] [Some ck,Some ca,Some cc, Some cx, Some ct] (ac_eq_eq)))
43.36 + val th1 = (pre RS(instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct] (ac_eq_eq)))
43.37 in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
43.38 end
43.39
43.40 |"Divides.op dvd" =>
43.41 let val pre = prove_elementar sg "lf"
43.42 (HOLogic.Not $ (HOLogic.mk_binrel "op =" (Const("0",HOLogic.intT),(mk_numeral k))))
43.43 - val th1 = (pre RS (instantiate' [] [Some ck,Some ca,Some cc, Some cx, Some ct]) (ac_dvd_eq))
43.44 + val th1 = (pre RS (instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct]) (ac_dvd_eq))
43.45 in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
43.46
43.47 end
43.48 end
43.49 - else ([], fn [] => instantiate' [Some cboolT] [Some (cterm_of sg fm)] refl)
43.50 + else ([], fn [] => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] refl)
43.51
43.52 |( Const ("Not", _) $ p) => ([p], fn [th] => th RS qe_Not)
43.53 |( Const ("op &",_) $ p $ q) => ([p,q], fn [th1,th2] => [th1,th2] MRS qe_conjI)
43.54 |( Const ("op |",_) $ p $ q) =>([p,q], fn [th1,th2] => [th1,th2] MRS qe_disjI)
43.55
43.56 - |_ => ([], fn [] => instantiate' [Some cboolT] [Some (cterm_of sg fm)] refl);
43.57 + |_ => ([], fn [] => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] refl);
43.58
43.59 fun proof_of_adjustcoeffeq sg x l = thm_of sg (decomp_adjustcoeffeq sg x l);
43.60
43.61 @@ -380,43 +380,43 @@
43.62 (*==================================================*)
43.63 fun rho_for_modd_minf x dlcm sg fm1 =
43.64 let
43.65 - (*Some certified Terms*)
43.66 + (*SOME certified Terms*)
43.67
43.68 val ctrue = cterm_of sg HOLogic.true_const
43.69 val cfalse = cterm_of sg HOLogic.false_const
43.70 val fm = norm_zero_one fm1
43.71 in case fm1 of
43.72 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
43.73 - if (x=y) andalso (c1= zero) andalso (c2= one) then (instantiate' [Some cboolT] [Some ctrue] (fm_modd_minf))
43.74 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
43.75 + if (x=y) andalso (c1= zero) andalso (c2= one) then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_minf))
43.76 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
43.77
43.78 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
43.79 if (is_arith_rel fm) andalso (x=y) andalso (c1= zero) andalso (c2= one)
43.80 - then (instantiate' [Some cboolT] [Some cfalse] (fm_modd_minf))
43.81 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
43.82 + then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_minf))
43.83 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
43.84
43.85 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
43.86 if (y=x) andalso (c1 = zero) then
43.87 - if (pm1 = one) then (instantiate' [Some cboolT] [Some cfalse] (fm_modd_minf)) else
43.88 - (instantiate' [Some cboolT] [Some ctrue] (fm_modd_minf))
43.89 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
43.90 + if (pm1 = one) then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_minf)) else
43.91 + (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_minf))
43.92 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
43.93
43.94 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.95 if y=x then let val cz = cterm_of sg (norm_zero_one z)
43.96 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
43.97 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_minf)))
43.98 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_minf)))
43.99 end
43.100 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
43.101 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
43.102 |(Const("Divides.op dvd",_)$ d $ (db as (Const ("op +",_) $ (Const ("op *",_) $
43.103 c $ y ) $ z))) =>
43.104 if y=x then let val cz = cterm_of sg (norm_zero_one z)
43.105 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
43.106 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_minf)))
43.107 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_minf)))
43.108 end
43.109 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
43.110 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
43.111
43.112
43.113 - |_ => instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf)
43.114 + |_ => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf)
43.115 end;
43.116 (*=========================================================================*)
43.117 (*=========================================================================*)
43.118 @@ -426,36 +426,36 @@
43.119 in case fm1 of
43.120 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
43.121 if (x=y) andalso (c1=zero) andalso (c2=one)
43.122 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (neq_eq_minf))
43.123 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
43.124 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (neq_eq_minf))
43.125 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
43.126
43.127 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
43.128 if (is_arith_rel fm) andalso (x=y) andalso ((c1=zero) orelse (c1 = norm_zero_one zero)) andalso ((c2=one) orelse (c1 = norm_zero_one one))
43.129 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (eq_eq_minf))
43.130 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
43.131 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (eq_eq_minf))
43.132 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
43.133
43.134 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
43.135 if (y=x) andalso (c1 =zero) then
43.136 - if pm1 = one then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (le_eq_minf)) else
43.137 - (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (len_eq_minf))
43.138 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
43.139 + if pm1 = one then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (le_eq_minf)) else
43.140 + (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (len_eq_minf))
43.141 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
43.142 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.143 if y=x then let val cd = cterm_of sg (norm_zero_one d)
43.144 val cz = cterm_of sg (norm_zero_one z)
43.145 - in(instantiate' [] [Some cd, Some cz] (not_dvd_eq_minf))
43.146 + in(instantiate' [] [SOME cd, SOME cz] (not_dvd_eq_minf))
43.147 end
43.148
43.149 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
43.150 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
43.151
43.152 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.153 if y=x then let val cd = cterm_of sg (norm_zero_one d)
43.154 val cz = cterm_of sg (norm_zero_one z)
43.155 - in(instantiate' [] [Some cd, Some cz ] (dvd_eq_minf))
43.156 + in(instantiate' [] [SOME cd, SOME cz ] (dvd_eq_minf))
43.157 end
43.158 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
43.159 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
43.160
43.161
43.162 - |_ => (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
43.163 + |_ => (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
43.164 end;
43.165
43.166 (*=====================================================*)
43.167 @@ -476,7 +476,7 @@
43.168 (* -------------------------------------------------------------*)
43.169 fun rho_for_modd_pinf x dlcm sg fm1 =
43.170 let
43.171 - (*Some certified Terms*)
43.172 + (*SOME certified Terms*)
43.173
43.174 val ctrue = cterm_of sg HOLogic.true_const
43.175 val cfalse = cterm_of sg HOLogic.false_const
43.176 @@ -484,37 +484,37 @@
43.177 in case fm1 of
43.178 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
43.179 if ((x=y) andalso (c1= zero) andalso (c2= one))
43.180 - then (instantiate' [Some cboolT] [Some ctrue] (fm_modd_pinf))
43.181 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
43.182 + then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_pinf))
43.183 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
43.184
43.185 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
43.186 if ((is_arith_rel fm) andalso (x = y) andalso (c1 = zero) andalso (c2 = one))
43.187 - then (instantiate' [Some cboolT] [Some cfalse] (fm_modd_pinf))
43.188 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
43.189 + then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_pinf))
43.190 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
43.191
43.192 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
43.193 if ((y=x) andalso (c1 = zero)) then
43.194 if (pm1 = one)
43.195 - then (instantiate' [Some cboolT] [Some ctrue] (fm_modd_pinf))
43.196 - else (instantiate' [Some cboolT] [Some cfalse] (fm_modd_pinf))
43.197 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
43.198 + then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_pinf))
43.199 + else (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_pinf))
43.200 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
43.201
43.202 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.203 if y=x then let val cz = cterm_of sg (norm_zero_one z)
43.204 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
43.205 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_pinf)))
43.206 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_pinf)))
43.207 end
43.208 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
43.209 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
43.210 |(Const("Divides.op dvd",_)$ d $ (db as (Const ("op +",_) $ (Const ("op *",_) $
43.211 c $ y ) $ z))) =>
43.212 if y=x then let val cz = cterm_of sg (norm_zero_one z)
43.213 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
43.214 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_pinf)))
43.215 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_pinf)))
43.216 end
43.217 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
43.218 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
43.219
43.220
43.221 - |_ => instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf)
43.222 + |_ => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf)
43.223 end;
43.224 (* -------------------------------------------------------------*)
43.225 (* Finding rho for pinf_eq *)
43.226 @@ -525,36 +525,36 @@
43.227 in case fm1 of
43.228 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
43.229 if (x=y) andalso (c1=zero) andalso (c2=one)
43.230 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (neq_eq_pinf))
43.231 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
43.232 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (neq_eq_pinf))
43.233 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
43.234
43.235 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
43.236 if (is_arith_rel fm) andalso (x=y) andalso ((c1=zero) orelse (c1 = norm_zero_one zero)) andalso ((c2=one) orelse (c1 = norm_zero_one one))
43.237 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (eq_eq_pinf))
43.238 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
43.239 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (eq_eq_pinf))
43.240 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
43.241
43.242 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
43.243 if (y=x) andalso (c1 =zero) then
43.244 - if pm1 = one then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (le_eq_pinf)) else
43.245 - (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (len_eq_pinf))
43.246 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
43.247 + if pm1 = one then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (le_eq_pinf)) else
43.248 + (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (len_eq_pinf))
43.249 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
43.250 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.251 if y=x then let val cd = cterm_of sg (norm_zero_one d)
43.252 val cz = cterm_of sg (norm_zero_one z)
43.253 - in(instantiate' [] [Some cd, Some cz] (not_dvd_eq_pinf))
43.254 + in(instantiate' [] [SOME cd, SOME cz] (not_dvd_eq_pinf))
43.255 end
43.256
43.257 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
43.258 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
43.259
43.260 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.261 if y=x then let val cd = cterm_of sg (norm_zero_one d)
43.262 val cz = cterm_of sg (norm_zero_one z)
43.263 - in(instantiate' [] [Some cd, Some cz ] (dvd_eq_pinf))
43.264 + in(instantiate' [] [SOME cd, SOME cz ] (dvd_eq_pinf))
43.265 end
43.266 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
43.267 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
43.268
43.269
43.270 - |_ => (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
43.271 + |_ => (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
43.272 end;
43.273
43.274
43.275 @@ -593,7 +593,7 @@
43.276 val cp = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
43.277 val cdlcm = cterm_of sg dlcm
43.278 val cB = cterm_of sg (list_to_set HOLogic.intT (map norm_zero_one bs))
43.279 - in instantiate' [] [Some cdlcm,Some cB, Some cp] (bst_thm)
43.280 + in instantiate' [] [SOME cdlcm,SOME cB, SOME cp] (bst_thm)
43.281 end;
43.282
43.283 fun asetproof_of sg (x as Free(xn,xT)) fm ast dlcm =
43.284 @@ -601,7 +601,7 @@
43.285 val cp = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
43.286 val cdlcm = cterm_of sg dlcm
43.287 val cA = cterm_of sg (list_to_set HOLogic.intT (map norm_zero_one ast))
43.288 - in instantiate' [] [Some cdlcm,Some cA, Some cp] (ast_thm)
43.289 + in instantiate' [] [SOME cdlcm,SOME cA, SOME cp] (ast_thm)
43.290 end;
43.291 *)
43.292
43.293 @@ -623,9 +623,9 @@
43.294 then let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ B)
43.295 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
43.296 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
43.297 - in (instantiate' [] [Some cfma]([th3,th1,th2] MRS (not_bst_p_ne)))
43.298 + in (instantiate' [] [SOME cfma]([th3,th1,th2] MRS (not_bst_p_ne)))
43.299 end
43.300 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
43.301 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
43.302
43.303 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", T) $(Const ("op *",_) $ c2 $ y) $z)) =>
43.304 if (is_arith_rel at) andalso (x=y)
43.305 @@ -633,40 +633,40 @@
43.306 in let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ bst_z $ B)
43.307 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq (bst_z,Const("op -",T) $ (Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)) $ (Const("1",HOLogic.intT))))
43.308 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
43.309 - in (instantiate' [] [Some cfma] ([th3,th1,th2] MRS (not_bst_p_eq)))
43.310 + in (instantiate' [] [SOME cfma] ([th3,th1,th2] MRS (not_bst_p_eq)))
43.311 end
43.312 end
43.313 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
43.314 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
43.315
43.316 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
43.317 if (y=x) andalso (c1 =zero) then
43.318 if pm1 = one then
43.319 let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ B)
43.320 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
43.321 - in (instantiate' [] [Some cfma, Some cdlcm]([th1,th2] MRS (not_bst_p_gt)))
43.322 + in (instantiate' [] [SOME cfma, SOME cdlcm]([th1,th2] MRS (not_bst_p_gt)))
43.323 end
43.324 else let val th1 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
43.325 - in (instantiate' [] [Some cfma, Some cB,Some (cterm_of sg (norm_zero_one z))] (th1 RS (not_bst_p_lt)))
43.326 + in (instantiate' [] [SOME cfma, SOME cB,SOME (cterm_of sg (norm_zero_one z))] (th1 RS (not_bst_p_lt)))
43.327 end
43.328 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
43.329 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
43.330
43.331 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.332 if y=x then
43.333 let val cz = cterm_of sg (norm_zero_one z)
43.334 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
43.335 - in (instantiate' [] [Some cfma, Some cB,Some cz] (th1 RS (not_bst_p_ndvd)))
43.336 + in (instantiate' [] [SOME cfma, SOME cB,SOME cz] (th1 RS (not_bst_p_ndvd)))
43.337 end
43.338 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
43.339 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
43.340
43.341 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.342 if y=x then
43.343 let val cz = cterm_of sg (norm_zero_one z)
43.344 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
43.345 - in (instantiate' [] [Some cfma,Some cB,Some cz] (th1 RS (not_bst_p_dvd)))
43.346 + in (instantiate' [] [SOME cfma,SOME cB,SOME cz] (th1 RS (not_bst_p_dvd)))
43.347 end
43.348 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
43.349 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
43.350
43.351 - |_ => (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
43.352 + |_ => (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
43.353
43.354 end;
43.355
43.356 @@ -714,9 +714,9 @@
43.357 then let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ A)
43.358 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
43.359 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
43.360 - in (instantiate' [] [Some cfma]([th3,th1,th2] MRS (not_ast_p_ne)))
43.361 + in (instantiate' [] [SOME cfma]([th3,th1,th2] MRS (not_ast_p_ne)))
43.362 end
43.363 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
43.364 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
43.365
43.366 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", T) $(Const ("op *",_) $ c2 $ y) $z)) =>
43.367 if (is_arith_rel at) andalso (x=y)
43.368 @@ -724,39 +724,39 @@
43.369 val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ ast_z $ A)
43.370 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq (ast_z,Const("op +",T) $ (Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)) $ (Const("1",HOLogic.intT))))
43.371 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
43.372 - in (instantiate' [] [Some cfma] ([th3,th1,th2] MRS (not_ast_p_eq)))
43.373 + in (instantiate' [] [SOME cfma] ([th3,th1,th2] MRS (not_ast_p_eq)))
43.374 end
43.375 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
43.376 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
43.377
43.378 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
43.379 if (y=x) andalso (c1 =zero) then
43.380 if pm1 = (mk_numeral ~1) then
43.381 let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one z) $ A)
43.382 val th2 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (zero,dlcm))
43.383 - in (instantiate' [] [Some cfma]([th2,th1] MRS (not_ast_p_lt)))
43.384 + in (instantiate' [] [SOME cfma]([th2,th1] MRS (not_ast_p_lt)))
43.385 end
43.386 else let val th1 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
43.387 - in (instantiate' [] [Some cfma, Some cA,Some (cterm_of sg (norm_zero_one z))] (th1 RS (not_ast_p_gt)))
43.388 + in (instantiate' [] [SOME cfma, SOME cA,SOME (cterm_of sg (norm_zero_one z))] (th1 RS (not_ast_p_gt)))
43.389 end
43.390 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
43.391 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
43.392
43.393 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.394 if y=x then
43.395 let val cz = cterm_of sg (norm_zero_one z)
43.396 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
43.397 - in (instantiate' [] [Some cfma, Some cA,Some cz] (th1 RS (not_ast_p_ndvd)))
43.398 + in (instantiate' [] [SOME cfma, SOME cA,SOME cz] (th1 RS (not_ast_p_ndvd)))
43.399 end
43.400 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
43.401 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
43.402
43.403 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
43.404 if y=x then
43.405 let val cz = cterm_of sg (norm_zero_one z)
43.406 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
43.407 - in (instantiate' [] [Some cfma,Some cA,Some cz] (th1 RS (not_ast_p_dvd)))
43.408 + in (instantiate' [] [SOME cfma,SOME cA,SOME cz] (th1 RS (not_ast_p_dvd)))
43.409 end
43.410 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
43.411 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
43.412
43.413 - |_ => (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
43.414 + |_ => (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
43.415
43.416 end;
43.417
43.418 @@ -788,21 +788,21 @@
43.419 fun rho_for_evalc sg at = case at of
43.420 (Const (p,_) $ s $ t) =>(
43.421 case assoc (operations,p) of
43.422 - Some f =>
43.423 + SOME f =>
43.424 ((if (f ((dest_numeral s),(dest_numeral t)))
43.425 then prove_elementar sg "ss" (HOLogic.mk_eq(at,HOLogic.true_const))
43.426 else prove_elementar sg "ss" (HOLogic.mk_eq(at, HOLogic.false_const)))
43.427 - handle _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl)
43.428 - | _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl )
43.429 + handle _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl)
43.430 + | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl )
43.431 |Const("Not",_)$(Const (p,_) $ s $ t) =>(
43.432 case assoc (operations,p) of
43.433 - Some f =>
43.434 + SOME f =>
43.435 ((if (f ((dest_numeral s),(dest_numeral t)))
43.436 then prove_elementar sg "ss" (HOLogic.mk_eq(at, HOLogic.false_const))
43.437 else prove_elementar sg "ss" (HOLogic.mk_eq(at,HOLogic.true_const)))
43.438 - handle _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl)
43.439 - | _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl )
43.440 - | _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl;
43.441 + handle _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl)
43.442 + | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl )
43.443 + | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl;
43.444
43.445
43.446 (*=========================================================*)
43.447 @@ -828,7 +828,7 @@
43.448 |(Const("op =", Type ("fun",[Type ("bool", []),_]))$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_eqI)
43.449 |(Const("Not",_)$p) => ([p],fn [th] => th RS qe_Not)
43.450 |(Const("Divides.op dvd",_)$d$r) =>
43.451 - if is_numeral d then ([], fn [] => (prove_elementar sg "lf" (HOLogic.mk_eq (r, lint vars r))) RS (instantiate' [] [None , None, Some (cterm_of sg d)](linearize_dvd)))
43.452 + if is_numeral d then ([], fn [] => (prove_elementar sg "lf" (HOLogic.mk_eq (r, lint vars r))) RS (instantiate' [] [NONE , NONE, SOME (cterm_of sg d)](linearize_dvd)))
43.453 else (warning "Nonlinear Term --- Non numeral leftside at dvd";
43.454 raise COOPER)
43.455 |_ => ([], fn [] => prove_elementar sg "lf" (HOLogic.mk_eq (t, linform vars t)));
43.456 @@ -897,7 +897,7 @@
43.457 val ss = presburger_ss addsimps
43.458 [simp_from_to] delsimps [P_eqtrue, P_eqfalse, bex_triv, insert_iff]
43.459 (* uth : EX x.P(l*x) = EX x. l dvd x & P x*)
43.460 - val uth = instantiate' [] [Some (cterm_of sg P) , Some (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
43.461 + val uth = instantiate' [] [SOME (cterm_of sg P) , SOME (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
43.462 (* e_ac_thm : Ex x. efm = EX x. fm*)
43.463 val e_ac_thm = (forall_intr (cterm_of sg x) ac_thm) COMP (qe_exI)
43.464 (* A and B set of the formula*)
43.465 @@ -961,7 +961,7 @@
43.466 val ss = presburger_ss addsimps
43.467 [simp_from_to] delsimps [P_eqtrue, P_eqfalse, bex_triv, insert_iff]
43.468 (* uth : EX x.P(l*x) = EX x. l dvd x & P x*)
43.469 - val uth = instantiate' [] [Some (cterm_of sg P) , Some (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
43.470 + val uth = instantiate' [] [SOME (cterm_of sg P) , SOME (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
43.471 (* e_ac_thm : Ex x. efm = EX x. fm*)
43.472 val e_ac_thm = (forall_intr (cterm_of sg x) ac_thm) COMP (qe_exI)
43.473 (* lsuth = EX.P(l*x) ; rsuth = EX x. l dvd x & P x*)
43.474 @@ -972,7 +972,7 @@
43.475 val (w,rs) = cooper_w [] cfm
43.476 val exp_cp_thm = case w of
43.477 (* FIXME - e_ac_thm just tipped to test syntactical correctness of the program!!!!*)
43.478 - Some n => e_ac_thm (* Prove cfm (n) and use exI and then Eq_TrueI*)
43.479 + SOME n => e_ac_thm (* Prove cfm (n) and use exI and then Eq_TrueI*)
43.480 |_ => let
43.481 (* A and B set of the formula*)
43.482 val A = aset x cfm
44.1 --- a/src/HOL/Integ/int_arith1.ML Fri Feb 11 18:51:00 2005 +0100
44.2 +++ b/src/HOL/Integ/int_arith1.ML Sun Feb 13 17:15:14 2005 +0100
44.3 @@ -93,10 +93,10 @@
44.4 structure Bin_Simprocs =
44.5 struct
44.6 fun prove_conv tacs sg (hyps: thm list) xs (t, u) =
44.7 - if t aconv u then None
44.8 + if t aconv u then NONE
44.9 else
44.10 let val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u))
44.11 - in Some (Tactic.prove sg xs [] eq (K (EVERY tacs))) end
44.12 + in SOME (Tactic.prove sg xs [] eq (K (EVERY tacs))) end
44.13
44.14 fun prove_conv_nohyps tacs sg = prove_conv tacs sg [];
44.15 fun prove_conv_nohyps_novars tacs sg = prove_conv tacs sg [] [];
44.16 @@ -119,10 +119,10 @@
44.17 0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
44.18 fun reorient_proc sg _ (_ $ t $ u) =
44.19 case u of
44.20 - Const("0", _) => None
44.21 - | Const("1", _) => None
44.22 - | Const("Numeral.number_of", _) $ _ => None
44.23 - | _ => Some (case t of
44.24 + Const("0", _) => NONE
44.25 + | Const("1", _) => NONE
44.26 + | Const("Numeral.number_of", _) $ _ => NONE
44.27 + | _ => SOME (case t of
44.28 Const("0", _) => meta_zero_reorient
44.29 | Const("1", _) => meta_one_reorient
44.30 | Const("Numeral.number_of", _) $ _ => meta_number_of_reorient)
44.31 @@ -305,8 +305,8 @@
44.32 [mult_assoc, minus_mult_left, minus_mult_eq_1_to_2];
44.33
44.34 (*Apply the given rewrite (if present) just once*)
44.35 -fun trans_tac None = all_tac
44.36 - | trans_tac (Some th) = ALLGOALS (rtac (th RS trans));
44.37 +fun trans_tac NONE = all_tac
44.38 + | trans_tac (SOME th) = ALLGOALS (rtac (th RS trans));
44.39
44.40 fun simplify_meta_eq rules =
44.41 simplify (HOL_basic_ss addeqcongs[eq_cong2] addsimps rules)
44.42 @@ -538,7 +538,7 @@
44.43 Addsimprocs [fast_int_arith_simproc]
44.44
44.45
44.46 -(* Some test data
44.47 +(* SOME test data
44.48 Goal "!!a::int. [| a <= b; c <= d; x+y<z |] ==> a+c <= b+d";
44.49 by (fast_arith_tac 1);
44.50 Goal "!!a::int. [| a < b; c < d |] ==> a-d+ 2 <= b+(-c)";
45.1 --- a/src/HOL/Integ/presburger.ML Fri Feb 11 18:51:00 2005 +0100
45.2 +++ b/src/HOL/Integ/presburger.ML Sun Feb 13 17:15:14 2005 +0100
45.3 @@ -73,7 +73,7 @@
45.4
45.5 fun term_typed_consts t = add_term_typed_consts(t,[]);
45.6
45.7 -(* Some Types*)
45.8 +(* SOME Types*)
45.9 val bT = HOLogic.boolT;
45.10 val iT = HOLogic.intT;
45.11 val binT = HOLogic.binT;
45.12 @@ -246,7 +246,7 @@
45.13 val g' = if a then abstract_pres sg g else g
45.14 (* Transform the term*)
45.15 val (t,np,nh) = prepare_for_presburger sg q g'
45.16 - (* Some simpsets for dealing with mod div abs and nat*)
45.17 + (* SOME simpsets for dealing with mod div abs and nat*)
45.18 val simpset0 = HOL_basic_ss
45.19 addsimps [mod_div_equality', Suc_plus1]
45.20 addsplits [split_zdiv, split_zmod, split_div', split_min, split_max]
45.21 @@ -313,7 +313,7 @@
45.22 "decision procedure for Presburger arithmetic"),
45.23 ArithTheoryData.map (fn {splits, inj_consts, discrete, presburger} =>
45.24 {splits = splits, inj_consts = inj_consts, discrete = discrete,
45.25 - presburger = Some (presburger_tac true false)})];
45.26 + presburger = SOME (presburger_tac true false)})];
45.27
45.28 end;
45.29
46.1 --- a/src/HOL/Integ/qelim.ML Fri Feb 11 18:51:00 2005 +0100
46.2 +++ b/src/HOL/Integ/qelim.ML Sun Feb 13 17:15:14 2005 +0100
46.3 @@ -51,7 +51,7 @@
46.4 end
46.5
46.6 |(Const("All",_)$Abs(xn,xT,p)) => ([(HOLogic.exists_const xT)$Abs(xn,xT,HOLogic.Not $ p)], fn [th] => th RS qe_ALL)
46.7 - | _ => ([],fn [] => instantiate' [Some (ctyp_of sg (type_of P))] [Some (cterm_of sg P)] refl);
46.8 + | _ => ([],fn [] => instantiate' [SOME (ctyp_of sg (type_of P))] [SOME (cterm_of sg P)] refl);
46.9
46.10
46.11 fun tproof_of_mlift_qelim sg isat afnp nfnp qfnp p =
47.1 --- a/src/HOL/IsaMakefile Fri Feb 11 18:51:00 2005 +0100
47.2 +++ b/src/HOL/IsaMakefile Sun Feb 13 17:15:14 2005 +0100
47.3 @@ -82,7 +82,7 @@
47.4 $(SRC)/TFL/usyntax.ML $(SRC)/TFL/utils.ML \
47.5 $(SRC)/Provers/eqsubst.ML\
47.6 eqrule_HOL_data.ML\
47.7 - Datatype.thy Datatype_Universe.thy \
47.8 + Datatype.ML Datatype.thy Datatype_Universe.thy \
47.9 Divides.thy Equiv_Relations.thy Extraction.thy Finite_Set.ML Finite_Set.thy \
47.10 Fun.thy Gfp.thy Hilbert_Choice.thy HOL.ML \
47.11 HOL.thy Inductive.thy Infinite_Set.thy Integ/Numeral.thy \
48.1 --- a/src/HOL/Isar_examples/Hoare.thy Fri Feb 11 18:51:00 2005 +0100
48.2 +++ b/src/HOL/Isar_examples/Hoare.thy Sun Feb 13 17:15:14 2005 +0100
48.3 @@ -262,8 +262,8 @@
48.4
48.5 fun upd_tr' (x_upd, T) =
48.6 (case try (unsuffix RecordPackage.updateN) x_upd of
48.7 - Some x => (x, if T = dummyT then T else Term.domain_type T)
48.8 - | None => raise Match);
48.9 + SOME x => (x, if T = dummyT then T else Term.domain_type T)
48.10 + | NONE => raise Match);
48.11
48.12 fun update_name_tr' (Free x) = Free (upd_tr' x)
48.13 | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
49.1 --- a/src/HOL/Library/EfficientNat.thy Fri Feb 11 18:51:00 2005 +0100
49.2 +++ b/src/HOL/Library/EfficientNat.thy Sun Feb 13 17:15:14 2005 +0100
49.3 @@ -117,8 +117,8 @@
49.4 val eqs1 = flat (map
49.5 (fn th => map (pair th) (find_vars (lhs_of th))) thms);
49.6 val eqs2 = map (fn x as (_, ((_, ctzero), _)) => (x, mapfilter (fn th =>
49.7 - Some (th, Thm.cterm_match (lhs_of th, ctzero))
49.8 - handle Pattern.MATCH => None) thms)) eqs1;
49.9 + SOME (th, Thm.cterm_match (lhs_of th, ctzero))
49.10 + handle Pattern.MATCH => NONE) thms)) eqs1;
49.11 fun distinct_vars vs = forall is_Var vs andalso null (duplicates vs);
49.12 val eqs2' = map (apsnd (filter (fn (_, (_, s)) =>
49.13 distinct_vars (map (term_of o snd) s)))) eqs2;
49.14 @@ -129,21 +129,21 @@
49.15 Thm.implies_elim (Thm.implies_elim
49.16 (Drule.fconv_rule (Thm.beta_conversion true)
49.17 (Drule.instantiate'
49.18 - [Some (ctyp_of_term ct)] [Some (Thm.cabs cv ct),
49.19 - Some (rhs_of th''), Some (Thm.cabs cv' (rhs_of th)), Some cv']
49.20 + [SOME (ctyp_of_term ct)] [SOME (Thm.cabs cv ct),
49.21 + SOME (rhs_of th''), SOME (Thm.cabs cv' (rhs_of th)), SOME cv']
49.22 Suc_if_eq')) th'') (Thm.forall_intr cv' th)
49.23 in
49.24 mapfilter (fn thm =>
49.25 - if thm = th then Some th'''
49.26 - else if b andalso thm = th' then None
49.27 - else Some thm) thms
49.28 + if thm = th then SOME th'''
49.29 + else if b andalso thm = th' then NONE
49.30 + else SOME thm) thms
49.31 end
49.32 in
49.33 case Library.find_first (not o null o snd) eqs2' of
49.34 - None => (case Library.find_first (not o null o snd) eqs2 of
49.35 - None => thms
49.36 - | Some x => remove_suc thy (mk_thms false x))
49.37 - | Some x => remove_suc thy (mk_thms true x)
49.38 + NONE => (case Library.find_first (not o null o snd) eqs2 of
49.39 + NONE => thms
49.40 + | SOME x => remove_suc thy (mk_thms false x))
49.41 + | SOME x => remove_suc thy (mk_thms true x)
49.42 end;
49.43
49.44 fun eqn_suc_preproc thy ths =
49.45 @@ -161,25 +161,25 @@
49.46 val Suc_clause' = Thm.transfer thy Suc_clause;
49.47 val vname = variant (map fst
49.48 (foldl add_term_varnames ([], map prop_of thms))) "x";
49.49 - fun find_var (t as Const ("Suc", _) $ (v as Var _)) = Some (t, v)
49.50 - | find_var (t $ u) = (case find_var t of None => find_var u | x => x)
49.51 - | find_var _ = None;
49.52 + fun find_var (t as Const ("Suc", _) $ (v as Var _)) = SOME (t, v)
49.53 + | find_var (t $ u) = (case find_var t of NONE => find_var u | x => x)
49.54 + | find_var _ = NONE;
49.55 fun find_thm th =
49.56 let val th' = ObjectLogic.atomize_thm th
49.57 in apsome (pair (th, th')) (find_var (prop_of th')) end
49.58 in
49.59 case get_first find_thm thms of
49.60 - None => thms
49.61 - | Some ((th, th'), (Sucv, v)) =>
49.62 + NONE => thms
49.63 + | SOME ((th, th'), (Sucv, v)) =>
49.64 let
49.65 val cert = cterm_of (sign_of_thm th);
49.66 val th'' = ObjectLogic.rulify (Thm.implies_elim
49.67 (Drule.fconv_rule (Thm.beta_conversion true)
49.68 (Drule.instantiate' []
49.69 - [Some (cert (lambda v (Abs ("x", HOLogic.natT,
49.70 + [SOME (cert (lambda v (Abs ("x", HOLogic.natT,
49.71 abstract_over (Sucv,
49.72 HOLogic.dest_Trueprop (prop_of th')))))),
49.73 - Some (cert v)] Suc_clause'))
49.74 + SOME (cert v)] Suc_clause'))
49.75 (Thm.forall_intr (cert v) th'))
49.76 in
49.77 remove_suc_clause thy (map (fn th''' =>
50.1 --- a/src/HOL/Library/word_setup.ML Fri Feb 11 18:51:00 2005 +0100
50.2 +++ b/src/HOL/Library/word_setup.ML Sun Feb 13 17:15:14 2005 +0100
50.3 @@ -24,17 +24,17 @@
50.4 fun add_word thy =
50.5 let
50.6 (*lcp** val fast1_th = PureThy.get_thm thy "Word.fast_nat_to_bv_def"**)
50.7 - val fast2_th = PureThy.get_thm thy ("Word.fast_bv_to_nat_def", None)
50.8 + val fast2_th = PureThy.get_thm thy ("Word.fast_bv_to_nat_def", NONE)
50.9 (*lcp** fun f sg thms (Const("Word.nat_to_bv",_) $ (Const("Numeral.number_of",_) $ t)) =
50.10 if num_is_usable t
50.11 - then Some (Drule.cterm_instantiate [(cterm_of sg (Var(("w",0),Type("Numeral.bin",[]))),cterm_of sg t)] fast1_th)
50.12 - else None
50.13 - | f _ _ _ = None **)
50.14 + then SOME (Drule.cterm_instantiate [(cterm_of sg (Var(("w",0),Type("Numeral.bin",[]))),cterm_of sg t)] fast1_th)
50.15 + else NONE
50.16 + | f _ _ _ = NONE **)
50.17 fun g sg thms (Const("Word.bv_to_nat",_) $ (t as (Const("List.list.Cons",_) $ _ $ _))) =
50.18 if vec_is_usable t
50.19 - then Some (Drule.cterm_instantiate [(cterm_of sg (Var(("bs",0),Type("List.list",[Type("Word.bit",[])]))),cterm_of sg t)] fast2_th)
50.20 - else None
50.21 - | g _ _ _ = None
50.22 + then SOME (Drule.cterm_instantiate [(cterm_of sg (Var(("bs",0),Type("List.list",[Type("Word.bit",[])]))),cterm_of sg t)] fast2_th)
50.23 + else NONE
50.24 + | g _ _ _ = NONE
50.25 (*lcp** val simproc1 = Simplifier.simproc (sign_of thy) "nat_to_bv" ["Word.nat_to_bv (number_of ?w)"] f ***)
50.26 val simproc2 = Simplifier.simproc (sign_of thy) "bv_to_nat" ["Word.bv_to_nat (?x # ?xs)"] g
50.27 in
51.1 --- a/src/HOL/List.thy Fri Feb 11 18:51:00 2005 +0100
51.2 +++ b/src/HOL/List.thy Sun Feb 13 17:15:14 2005 +0100
51.3 @@ -430,12 +430,12 @@
51.4 val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr)
51.5 val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2));
51.6 val thm = Tactic.prove sg [] [] eq (K (rearr_tac 1));
51.7 - in Some ((conv RS (thm RS trans)) RS eq_reflection) end;
51.8 + in SOME ((conv RS (thm RS trans)) RS eq_reflection) end;
51.9
51.10 in
51.11 if list1 lastl andalso list1 lastr then rearr append1_eq_conv
51.12 else if lastl aconv lastr then rearr append_same_eq
51.13 - else None
51.14 + else NONE
51.15 end;
51.16
51.17 in
51.18 @@ -2118,17 +2118,17 @@
51.19 fun list_codegen thy gr dep b t =
51.20 let val (gr', ps) = foldl_map (Codegen.invoke_codegen thy dep false)
51.21 (gr, HOLogic.dest_list t)
51.22 - in Some (gr', Pretty.list "[" "]" ps) end handle TERM _ => None;
51.23 + in SOME (gr', Pretty.list "[" "]" ps) end handle TERM _ => NONE;
51.24
51.25 fun dest_nibble (Const (s, _)) = int_of_nibble (unprefix "List.nibble.Nibble" s)
51.26 | dest_nibble _ = raise Match;
51.27
51.28 fun char_codegen thy gr dep b (Const ("List.char.Char", _) $ c1 $ c2) =
51.29 (let val c = chr (dest_nibble c1 * 16 + dest_nibble c2)
51.30 - in if Symbol.is_printable c then Some (gr, Pretty.quote (Pretty.str c))
51.31 - else None
51.32 - end handle LIST _ => None | Match => None)
51.33 - | char_codegen thy gr dep b _ = None;
51.34 + in if Symbol.is_printable c then SOME (gr, Pretty.quote (Pretty.str c))
51.35 + else NONE
51.36 + end handle LIST _ => NONE | Match => NONE)
51.37 + | char_codegen thy gr dep b _ = NONE;
51.38
51.39 in
51.40
52.1 --- a/src/HOL/Main.thy Fri Feb 11 18:51:00 2005 +0100
52.2 +++ b/src/HOL/Main.thy Sun Feb 13 17:15:14 2005 +0100
52.3 @@ -42,18 +42,18 @@
52.4 val eq_codegen_setup = [Codegen.add_codegen "eq_codegen"
52.5 (fn thy => fn gr => fn dep => fn b => fn t =>
52.6 (case strip_comb t of
52.7 - (Const ("op =", Type (_, [Type ("fun", _), _])), _) => None
52.8 + (Const ("op =", Type (_, [Type ("fun", _), _])), _) => NONE
52.9 | (Const ("op =", _), [t, u]) =>
52.10 let
52.11 val (gr', pt) = Codegen.invoke_codegen thy dep false (gr, t);
52.12 val (gr'', pu) = Codegen.invoke_codegen thy dep false (gr', u)
52.13 in
52.14 - Some (gr'', Codegen.parens
52.15 + SOME (gr'', Codegen.parens
52.16 (Pretty.block [pt, Pretty.str " =", Pretty.brk 1, pu]))
52.17 end
52.18 - | (t as Const ("op =", _), ts) => Some (Codegen.invoke_codegen
52.19 + | (t as Const ("op =", _), ts) => SOME (Codegen.invoke_codegen
52.20 thy dep b (gr, Codegen.eta_expand t ts 2))
52.21 - | _ => None))];
52.22 + | _ => NONE))];
52.23
52.24 fun gen_bool i = one_of [false, true];
52.25
53.1 --- a/src/HOL/Matrix/Cplex.ML Fri Feb 11 18:51:00 2005 +0100
53.2 +++ b/src/HOL/Matrix/Cplex.ML Sun Feb 13 17:15:14 2005 +0100
53.3 @@ -81,8 +81,8 @@
53.4 | rev_cmp cplexGeq = cplexLeq
53.5 | rev_cmp cplexEq = cplexEq
53.6
53.7 -fun the None = raise (Load_cplexFile "Some expected")
53.8 - | the (Some x) = x;
53.9 +fun the NONE = raise (Load_cplexFile "SOME expected")
53.10 + | the (SOME x) = x;
53.11
53.12 fun modulo_signed is_something (cplexNeg u) = is_something u
53.13 | modulo_signed is_something u = is_something u
53.14 @@ -189,25 +189,25 @@
53.15 val a = to_upper x
53.16 in
53.17 if a = "BOUNDS" orelse a = "BOUND" then
53.18 - Some "BOUNDS"
53.19 + SOME "BOUNDS"
53.20 else if a = "MINIMIZE" orelse a = "MINIMUM" orelse a = "MIN" then
53.21 - Some "MINIMIZE"
53.22 + SOME "MINIMIZE"
53.23 else if a = "MAXIMIZE" orelse a = "MAXIMUM" orelse a = "MAX" then
53.24 - Some "MAXIMIZE"
53.25 + SOME "MAXIMIZE"
53.26 else if a = "ST" orelse a = "S.T." orelse a = "ST." then
53.27 - Some "ST"
53.28 + SOME "ST"
53.29 else if a = "FREE" orelse a = "END" then
53.30 - Some a
53.31 + SOME a
53.32 else if a = "GENERAL" orelse a = "GENERALS" orelse a = "GEN" then
53.33 - Some "GENERAL"
53.34 + SOME "GENERAL"
53.35 else if a = "INTEGER" orelse a = "INTEGERS" orelse a = "INT" then
53.36 - Some "INTEGER"
53.37 + SOME "INTEGER"
53.38 else if a = "BINARY" orelse a = "BINARIES" orelse a = "BIN" then
53.39 - Some "BINARY"
53.40 + SOME "BINARY"
53.41 else if a = "INF" orelse a = "INFINITY" then
53.42 - Some "INF"
53.43 + SOME "INF"
53.44 else
53.45 - None
53.46 + NONE
53.47 end
53.48
53.49 val TOKEN_ERROR = ~1
53.50 @@ -303,12 +303,12 @@
53.51 let val u = hd (!rest) in
53.52 (
53.53 rest := tl (!rest);
53.54 - Some u
53.55 + SOME u
53.56 )
53.57 end
53.58 else
53.59 let val s = TextIO.inputLine f in
53.60 - if s = "" then None else
53.61 + if s = "" then NONE else
53.62 let val t = tokenize s in
53.63 if (length t >= 2 andalso
53.64 snd(hd (tl t)) = ":")
53.65 @@ -326,12 +326,12 @@
53.66
53.67 fun readToken_helper2 () =
53.68 let val c = readToken_helper () in
53.69 - if c = None then None
53.70 + if c = NONE then NONE
53.71 else if !ignore_NL andalso fst (the c) = TOKEN_NL then
53.72 readToken_helper2 ()
53.73 else if fst (the c) = TOKEN_SYMBOL
53.74 - andalso keyword (snd (the c)) <> None
53.75 - then Some (TOKEN_KEYWORD, the (keyword (snd (the c))))
53.76 + andalso keyword (snd (the c)) <> NONE
53.77 + then SOME (TOKEN_KEYWORD, the (keyword (snd (the c))))
53.78 else c
53.79 end
53.80
53.81 @@ -354,78 +354,78 @@
53.82
53.83 fun readTerm_Product only_num =
53.84 let val c = readToken () in
53.85 - if c = None then None
53.86 + if c = NONE then NONE
53.87 else if fst (the c) = TOKEN_SYMBOL
53.88 then (
53.89 - if only_num then (pushToken (the c); None)
53.90 - else Some (cplexVar (snd (the c)))
53.91 + if only_num then (pushToken (the c); NONE)
53.92 + else SOME (cplexVar (snd (the c)))
53.93 )
53.94 else if only_num andalso is_value (the c) then
53.95 - Some (get_value (the c))
53.96 + SOME (get_value (the c))
53.97 else if is_value (the c) then
53.98 let val t1 = get_value (the c)
53.99 val d = readToken ()
53.100 in
53.101 - if d = None then Some t1
53.102 + if d = NONE then SOME t1
53.103 else if fst (the d) = TOKEN_SYMBOL then
53.104 - Some (cplexProd (t1, cplexVar (snd (the d))))
53.105 + SOME (cplexProd (t1, cplexVar (snd (the d))))
53.106 else
53.107 - (pushToken (the d); Some t1)
53.108 + (pushToken (the d); SOME t1)
53.109 end
53.110 - else (pushToken (the c); None)
53.111 + else (pushToken (the c); NONE)
53.112 end
53.113
53.114 fun readTerm_Signed only_signed only_num =
53.115 let
53.116 val c = readToken ()
53.117 in
53.118 - if c = None then None
53.119 + if c = NONE then NONE
53.120 else
53.121 let val d = the c in
53.122 if d = (TOKEN_DELIMITER, "+") then
53.123 readTerm_Product only_num
53.124 else if d = (TOKEN_DELIMITER, "-") then
53.125 - Some (cplexNeg (the (readTerm_Product
53.126 + SOME (cplexNeg (the (readTerm_Product
53.127 only_num)))
53.128 else (pushToken d;
53.129 - if only_signed then None
53.130 + if only_signed then NONE
53.131 else readTerm_Product only_num)
53.132 end
53.133 end
53.134
53.135 fun readTerm_Sum first_signed =
53.136 let val c = readTerm_Signed first_signed false in
53.137 - if c = None then [] else (the c)::(readTerm_Sum true)
53.138 + if c = NONE then [] else (the c)::(readTerm_Sum true)
53.139 end
53.140
53.141 fun readTerm () =
53.142 let val c = readTerm_Sum false in
53.143 - if c = [] then None
53.144 - else if tl c = [] then Some (hd c)
53.145 - else Some (cplexSum c)
53.146 + if c = [] then NONE
53.147 + else if tl c = [] then SOME (hd c)
53.148 + else SOME (cplexSum c)
53.149 end
53.150
53.151 fun readLabeledTerm () =
53.152 let val c = readToken () in
53.153 - if c = None then (None, None)
53.154 + if c = NONE then (NONE, NONE)
53.155 else if fst (the c) = TOKEN_LABEL then
53.156 let val t = readTerm () in
53.157 - if t = None then
53.158 + if t = NONE then
53.159 raise (Load_cplexFile ("term after label "^
53.160 (snd (the c))^
53.161 " expected"))
53.162 - else (Some (snd (the c)), t)
53.163 + else (SOME (snd (the c)), t)
53.164 end
53.165 - else (pushToken (the c); (None, readTerm ()))
53.166 + else (pushToken (the c); (NONE, readTerm ()))
53.167 end
53.168
53.169 fun readGoal () =
53.170 let
53.171 val g = readToken ()
53.172 in
53.173 - if g = Some (TOKEN_KEYWORD, "MAXIMIZE") then
53.174 + if g = SOME (TOKEN_KEYWORD, "MAXIMIZE") then
53.175 cplexMaximize (the (snd (readLabeledTerm ())))
53.176 - else if g = Some (TOKEN_KEYWORD, "MINIMIZE") then
53.177 + else if g = SOME (TOKEN_KEYWORD, "MINIMIZE") then
53.178 cplexMinimize (the (snd (readLabeledTerm ())))
53.179 else raise (Load_cplexFile "MAXIMIZE or MINIMIZE expected")
53.180 end
53.181 @@ -447,17 +447,17 @@
53.182 (str2cmp b,
53.183 (t1, t2))
53.184 in
53.185 - if snd t = None then None
53.186 + if snd t = NONE then NONE
53.187 else
53.188 let val c = readToken () in
53.189 - if c = None orelse fst (the c) <> TOKEN_CMP
53.190 + if c = NONE orelse fst (the c) <> TOKEN_CMP
53.191 then raise (Load_cplexFile "TOKEN_CMP expected")
53.192 else
53.193 let val n = readTerm_Signed false true in
53.194 - if n = None then
53.195 + if n = NONE then
53.196 raise (Load_cplexFile "num expected")
53.197 else
53.198 - Some (fst t,
53.199 + SOME (fst t,
53.200 make_constraint (snd (the c))
53.201 (the (snd t))
53.202 (the n))
53.203 @@ -469,10 +469,10 @@
53.204 let
53.205 fun readbody () =
53.206 let val t = readConstraint () in
53.207 - if t = None then []
53.208 + if t = NONE then []
53.209 else if (is_normed_Constr (snd (the t))) then
53.210 (the t)::(readbody ())
53.211 - else if (fst (the t) <> None) then
53.212 + else if (fst (the t) <> NONE) then
53.213 raise (Load_cplexFile
53.214 ("constraint '"^(the (fst (the t)))^
53.215 "'is not normed"))
53.216 @@ -481,7 +481,7 @@
53.217 "constraint is not normed")
53.218 end
53.219 in
53.220 - if readToken () = Some (TOKEN_KEYWORD, "ST")
53.221 + if readToken () = SOME (TOKEN_KEYWORD, "ST")
53.222 then
53.223 readbody ()
53.224 else
53.225 @@ -490,15 +490,15 @@
53.226
53.227 fun readCmp () =
53.228 let val c = readToken () in
53.229 - if c = None then None
53.230 + if c = NONE then NONE
53.231 else if fst (the c) = TOKEN_CMP then
53.232 - Some (str2cmp (snd (the c)))
53.233 - else (pushToken (the c); None)
53.234 + SOME (str2cmp (snd (the c)))
53.235 + else (pushToken (the c); NONE)
53.236 end
53.237
53.238 fun skip_NL () =
53.239 let val c = readToken () in
53.240 - if c <> None andalso fst (the c) = TOKEN_NL then
53.241 + if c <> NONE andalso fst (the c) = TOKEN_NL then
53.242 skip_NL ()
53.243 else
53.244 (pushToken (the c); ())
53.245 @@ -515,17 +515,17 @@
53.246 val _ = skip_NL ()
53.247 val t1 = readTerm ()
53.248 in
53.249 - if t1 = None then None
53.250 + if t1 = NONE then NONE
53.251 else
53.252 let
53.253 val c1 = readCmp ()
53.254 in
53.255 - if c1 = None then
53.256 + if c1 = NONE then
53.257 let
53.258 val c = readToken ()
53.259 in
53.260 - if c = Some (TOKEN_KEYWORD, "FREE") then
53.261 - Some (
53.262 + if c = SOME (TOKEN_KEYWORD, "FREE") then
53.263 + SOME (
53.264 cplexBounds (cplexNeg cplexInf,
53.265 cplexLeq,
53.266 the t1,
53.267 @@ -538,16 +538,16 @@
53.268 let
53.269 val t2 = readTerm ()
53.270 in
53.271 - if t2 = None then
53.272 + if t2 = NONE then
53.273 raise (Load_cplexFile "term expected")
53.274 else
53.275 let val c2 = readCmp () in
53.276 - if c2 = None then
53.277 - Some (make_bounds (the c1)
53.278 + if c2 = NONE then
53.279 + SOME (make_bounds (the c1)
53.280 (the t1)
53.281 (the t2))
53.282 else
53.283 - Some (
53.284 + SOME (
53.285 cplexBounds (the t1,
53.286 the c1,
53.287 the t2,
53.288 @@ -565,7 +565,7 @@
53.289 let
53.290 val b = readBound ()
53.291 in
53.292 - if b = None then []
53.293 + if b = NONE then []
53.294 else if (is_normed_Bounds (the b)) then
53.295 (the b)::(readbody())
53.296 else (
53.297 @@ -574,13 +574,13 @@
53.298 (makestring (the b)))))
53.299 end
53.300 in
53.301 - if readToken () = Some (TOKEN_KEYWORD, "BOUNDS") then
53.302 + if readToken () = SOME (TOKEN_KEYWORD, "BOUNDS") then
53.303 readbody ()
53.304 else raise (Load_cplexFile "BOUNDS expected")
53.305 end
53.306
53.307 fun readEnd () =
53.308 - if readToken () = Some (TOKEN_KEYWORD, "END") then ()
53.309 + if readToken () = SOME (TOKEN_KEYWORD, "END") then ()
53.310 else raise (Load_cplexFile "END expected")
53.311
53.312 val result_Goal = readGoal ()
53.313 @@ -648,7 +648,7 @@
53.314
53.315 fun write_constraints [] = ()
53.316 | write_constraints (c::cs) =
53.317 - (if (fst c <> None)
53.318 + (if (fst c <> NONE)
53.319 then
53.320 (write (the (fst c)); write ": ")
53.321 else
53.322 @@ -767,7 +767,7 @@
53.323 val zero = cplexNum "0"
53.324
53.325 fun make_pos_constr v =
53.326 - (None, cplexConstr (cplexGeq, ((cplexVar v), zero)))
53.327 + (NONE, cplexConstr (cplexGeq, ((cplexVar v), zero)))
53.328
53.329 fun make_free_bound v =
53.330 cplexBounds (cplexNeg cplexInf, cplexLeq,
53.331 @@ -777,7 +777,7 @@
53.332 val pos_constrs = rev(Symtab.foldl
53.333 (fn (l, (k,v)) => (make_pos_constr k) :: l)
53.334 ([], positive_vars))
53.335 - val bound_constrs = map (fn x => (None, x))
53.336 + val bound_constrs = map (fn x => (NONE, x))
53.337 (flat (map bound2constr bounds))
53.338 val constraints' = constraints @ pos_constrs @ bound_constrs
53.339 val bounds' = rev(Symtab.foldl (fn (l, (v,_)) =>
53.340 @@ -859,17 +859,17 @@
53.341 let val u = hd (!rest) in
53.342 (
53.343 rest := tl (!rest);
53.344 - Some u
53.345 + SOME u
53.346 )
53.347 end
53.348 else
53.349 let val s = TextIO.inputLine f in
53.350 - if s = "" then None else (rest := tokenize s; readToken_helper())
53.351 + if s = "" then NONE else (rest := tokenize s; readToken_helper())
53.352 end
53.353
53.354 - fun is_tt tok ty = (tok <> None andalso (fst (the tok)) = ty)
53.355 + fun is_tt tok ty = (tok <> NONE andalso (fst (the tok)) = ty)
53.356
53.357 - fun pushToken a = if a = None then () else (rest := ((the a)::(!rest)))
53.358 + fun pushToken a = if a = NONE then () else (rest := ((the a)::(!rest)))
53.359
53.360 fun readToken () =
53.361 let val t = readToken_helper () in
53.362 @@ -878,14 +878,14 @@
53.363 else if is_tt t TOKEN_NL then
53.364 let val t2 = readToken_helper () in
53.365 if is_tt t2 TOKEN_SIGN then
53.366 - (pushToken (Some (TOKEN_SEPARATOR, "-")); t)
53.367 + (pushToken (SOME (TOKEN_SEPARATOR, "-")); t)
53.368 else
53.369 (pushToken t2; t)
53.370 end
53.371 else if is_tt t TOKEN_SIGN then
53.372 let val t2 = readToken_helper () in
53.373 if is_tt t2 TOKEN_NUM then
53.374 - (Some (TOKEN_NUM, (snd (the t))^(snd (the t2))))
53.375 + (SOME (TOKEN_NUM, (snd (the t))^(snd (the t2))))
53.376 else
53.377 (pushToken t2; t)
53.378 end
53.379 @@ -897,7 +897,7 @@
53.380 let
53.381 val t = readToken ()
53.382 in
53.383 - if is_tt t TOKEN_NL orelse t = None
53.384 + if is_tt t TOKEN_NL orelse t = NONE
53.385 then P
53.386 else readRestOfLine P
53.387 end
53.388 @@ -940,26 +940,26 @@
53.389 val k = readToken ()
53.390 in
53.391 if is_tt k TOKEN_NUM then
53.392 - readRestOfLine (Some (snd (the t2), snd (the k)))
53.393 + readRestOfLine (SOME (snd (the t2), snd (the k)))
53.394 else
53.395 raise (Load_cplexResult "number expected")
53.396 end
53.397 else
53.398 - (pushToken t2; pushToken t1; None)
53.399 + (pushToken t2; pushToken t1; NONE)
53.400 end
53.401
53.402 fun load_values () =
53.403 let val v = load_value () in
53.404 - if v = None then [] else (the v)::(load_values ())
53.405 + if v = NONE then [] else (the v)::(load_values ())
53.406 end
53.407
53.408 val header = readHeader ()
53.409
53.410 val result =
53.411 case assoc (header, "STATUS") of
53.412 - Some "INFEASIBLE" => Infeasible
53.413 - | Some "UNBOUNDED" => Unbounded
53.414 - | Some "OPTIMAL" => Optimal (the (assoc (header, "OBJECTIVE")),
53.415 + SOME "INFEASIBLE" => Infeasible
53.416 + | SOME "UNBOUNDED" => Unbounded
53.417 + | SOME "OPTIMAL" => Optimal (the (assoc (header, "OBJECTIVE")),
53.418 (skip_until_sep ();
53.419 skip_until_sep ();
53.420 load_values ()))
54.1 --- a/src/HOL/Matrix/CplexMatrixConverter.ML Fri Feb 11 18:51:00 2005 +0100
54.2 +++ b/src/HOL/Matrix/CplexMatrixConverter.ML Sun Feb 13 17:15:14 2005 +0100
54.3 @@ -59,10 +59,10 @@
54.4
54.5 val (varcount, i2s_tab, s2i_tab) = build_naming 0 Inttab.empty Symtab.empty bounds
54.6
54.7 - fun i2s i = case Inttab.lookup (i2s_tab, i) of None => raise (Converter "index not found")
54.8 - | Some n => n
54.9 - fun s2i s = case Symtab.lookup (s2i_tab, s) of None => raise (Converter ("name not found: "^s))
54.10 - | Some i => i
54.11 + fun i2s i = case Inttab.lookup (i2s_tab, i) of NONE => raise (Converter "index not found")
54.12 + | SOME n => n
54.13 + fun s2i s = case Symtab.lookup (s2i_tab, s) of NONE => raise (Converter ("name not found: "^s))
54.14 + | SOME i => i
54.15 fun num2str positive (cplexNeg t) = num2str (not positive) t
54.16 | num2str positive (cplexNum num) = if positive then num else "-"^num
54.17 | num2str _ _ = raise (Converter "term is not a (possibly signed) number")
54.18 @@ -82,8 +82,8 @@
54.19 | constrs2Ab j A b ((_, cplexConstr (cplexGeq, (t1,t2)))::cs) =
54.20 constrs2Ab (j+1) (set_vector A j (sum2vec (neg_term t1))) (set_elem b j (num2str true (neg_term t2))) cs
54.21 | constrs2Ab j A b ((_, cplexConstr (cplexEq, (t1,t2)))::cs) =
54.22 - constrs2Ab j A b ((None, cplexConstr (cplexLeq, (t1,t2)))::
54.23 - (None, cplexConstr (cplexGeq, (t1, t2)))::cs)
54.24 + constrs2Ab j A b ((NONE, cplexConstr (cplexLeq, (t1,t2)))::
54.25 + (NONE, cplexConstr (cplexGeq, (t1, t2)))::cs)
54.26 | constrs2Ab _ _ _ _ = raise (Converter "no strict constraints allowed")
54.27
54.28 val (A, b) = constrs2Ab 0 empty_matrix empty_vector constrs
55.1 --- a/src/HOL/Matrix/FloatSparseMatrixBuilder.ML Fri Feb 11 18:51:00 2005 +0100
55.2 +++ b/src/HOL/Matrix/FloatSparseMatrixBuilder.ML Sun Feb 13 17:15:14 2005 +0100
55.3 @@ -226,8 +226,8 @@
55.4 let
55.5 fun upd m j i x =
55.6 case Inttab.lookup (m, j) of
55.7 - Some v => Inttab.update ((j, Inttab.update ((i, x), v)), m)
55.8 - | None => Inttab.update ((j, Inttab.update ((i, x), Inttab.empty)), m)
55.9 + SOME v => Inttab.update ((j, Inttab.update ((i, x), v)), m)
55.10 + | NONE => Inttab.update ((j, Inttab.update ((i, x), Inttab.empty)), m)
55.11
55.12 fun updv j (m, (i, s)) = upd m i j s
55.13
55.14 @@ -274,11 +274,11 @@
55.15
55.16 fun mk_constr index vector c =
55.17 let
55.18 - val s = case Inttab.lookup (c, index) of Some s => s | None => "0"
55.19 + val s = case Inttab.lookup (c, index) of SOME s => s | NONE => "0"
55.20 val (p, s) = split_numstr s
55.21 val num = if p then cplex.cplexNum s else cplex.cplexNeg (cplex.cplexNum s)
55.22 in
55.23 - (None, cplex.cplexConstr (cplex.cplexLeq, (vec2sum vector, num)))
55.24 + (NONE, cplex.cplexConstr (cplex.cplexLeq, (vec2sum vector, num)))
55.25 end
55.26
55.27 fun delete index c = Inttab.delete index c handle Inttab.UNDEF _ => c
55.28 @@ -327,11 +327,11 @@
55.29
55.30 fun mk_constr index vector c =
55.31 let
55.32 - val s = case Inttab.lookup (c, index) of Some s => s | None => "0"
55.33 + val s = case Inttab.lookup (c, index) of SOME s => s | NONE => "0"
55.34 val (p, s) = split_numstr s
55.35 val num = if p then cplex.cplexNum s else cplex.cplexNeg (cplex.cplexNum s)
55.36 in
55.37 - (None, cplex.cplexConstr (cplex.cplexEq, (vec2sum vector, num)))
55.38 + (NONE, cplex.cplexConstr (cplex.cplexEq, (vec2sum vector, num)))
55.39 end
55.40
55.41 fun delete index c = Inttab.delete index c handle Inttab.UNDEF _ => c
55.42 @@ -361,12 +361,12 @@
55.43 fun cut_matrix vfilter vsize m =
55.44 let
55.45 fun app (m, (i, v)) =
55.46 - if (Inttab.lookup (vfilter, i) = None) then
55.47 + if (Inttab.lookup (vfilter, i) = NONE) then
55.48 m
55.49 else
55.50 case vsize of
55.51 - None => Inttab.update ((i,v), m)
55.52 - | Some s => Inttab.update((i, cut_vector s v),m)
55.53 + NONE => Inttab.update ((i,v), m)
55.54 + | SOME s => Inttab.update((i, cut_vector s v),m)
55.55 in
55.56 Inttab.foldl app (empty_matrix, m)
55.57 end
55.58 @@ -376,10 +376,10 @@
55.59
55.60 fun v_only_elem v =
55.61 case Inttab.min_key v of
55.62 - None => None
55.63 - | Some vmin => (case Inttab.max_key v of
55.64 - None => Some vmin
55.65 - | Some vmax => if vmin = vmax then Some vmin else None)
55.66 + NONE => NONE
55.67 + | SOME vmin => (case Inttab.max_key v of
55.68 + NONE => SOME vmin
55.69 + | SOME vmax => if vmin = vmax then SOME vmin else NONE)
55.70
55.71 fun v_fold f a v = Inttab.foldl f (a,v)
55.72
56.1 --- a/src/HOL/Matrix/codegen_prep.ML Fri Feb 11 18:51:00 2005 +0100
56.2 +++ b/src/HOL/Matrix/codegen_prep.ML Sun Feb 13 17:15:14 2005 +0100
56.3 @@ -74,8 +74,8 @@
56.4 val key = f x
56.5 in
56.6 case assoc (g, key) of
56.7 - None => (key, [x])::g
56.8 - | Some l => overwrite (g, (key, x::l))
56.9 + NONE => (key, [x])::g
56.10 + | SOME l => overwrite (g, (key, x::l))
56.11 end
56.12
56.13 fun prepare_thms ths =
57.1 --- a/src/HOL/Matrix/eq_codegen.ML Fri Feb 11 18:51:00 2005 +0100
57.2 +++ b/src/HOL/Matrix/eq_codegen.ML Sun Feb 13 17:15:14 2005 +0100
57.3 @@ -12,8 +12,8 @@
57.4 val (_, eq) = Thm.dest_comb (cprop_of thm);
57.5 val (ct, rhs) = Thm.dest_comb eq;
57.6 val (_, lhs) = Thm.dest_comb ct
57.7 - in Thm.implies_elim (Drule.instantiate' [Some (ctyp_of_term lhs)]
57.8 - [Some lhs, Some rhs] eq_reflection) thm
57.9 + in Thm.implies_elim (Drule.instantiate' [SOME (ctyp_of_term lhs)]
57.10 + [SOME lhs, SOME rhs] eq_reflection) thm
57.11 end;
57.12
57.13 structure SimprocsCodegen =
57.14 @@ -51,7 +51,7 @@
57.15 decomp_term_code cn ((v1 :: v2 :: vs,
57.16 bs @ [(Free (s, T), v1)],
57.17 ps @ [mk_val [v1, v2] [Pretty.str "Thm.dest_abs", Pretty.brk 1,
57.18 - Pretty.str "None", Pretty.brk 1, Pretty.str v]]), (v2, t))
57.19 + Pretty.str "NONE", Pretty.brk 1, Pretty.str v]]), (v2, t))
57.20 end
57.21 | t $ u =>
57.22 let
57.23 @@ -143,7 +143,7 @@
57.24 | mk_cterm_code b ty_bs ts xs (vals, Abs (s, T, t)) =
57.25 let
57.26 val u = Free (s, T);
57.27 - val Some s' = assoc (ts, u);
57.28 + val SOME s' = assoc (ts, u);
57.29 val p = Pretty.str s';
57.30 val (vals', p') = mk_cterm_code true ty_bs ts (p :: xs)
57.31 (if null (typ_tvars T) then vals
57.32 @@ -153,13 +153,13 @@
57.33 end
57.34 | mk_cterm_code b ty_bs ts xs (vals, Bound i) = (vals, nth_elem (i, xs))
57.35 | mk_cterm_code b ty_bs ts xs (vals, t) = (case assoc (vals, t) of
57.36 - None =>
57.37 - let val Some s = assoc (ts, t)
57.38 + NONE =>
57.39 + let val SOME s = assoc (ts, t)
57.40 in (if is_Const t andalso not (null (term_tvars t)) then
57.41 vals @ [(t, (("", s), [mk_val [s] [inst_ty true ty_bs t s]]))]
57.42 else vals, Pretty.str s)
57.43 end
57.44 - | Some ((_, s), _) => (vals, Pretty.str s));
57.45 + | SOME ((_, s), _) => (vals, Pretty.str s));
57.46
57.47 fun get_cases sg =
57.48 Symtab.foldl (fn (tab, (k, {case_rewrites, ...})) => Symtab.update_new
57.49 @@ -195,8 +195,8 @@
57.50 *)
57.51
57.52 fun lookup sg fs t = (case Library.find_first (is_instance sg t o fst) fs of
57.53 - None => (bla := (t ins !bla); None)
57.54 - | Some (_, x) => Some x);
57.55 + NONE => (bla := (t ins !bla); NONE)
57.56 + | SOME (_, x) => SOME x);
57.57
57.58 fun unint sg fs t = forall (is_none o lookup sg fs) (term_consts' t);
57.59
57.60 @@ -220,15 +220,15 @@
57.61
57.62 fun mk_simpl_code sg case_tab mkeq fs ts ty_bs thm_bs ((vs, vals), t) =
57.63 (case assoc (vals, t) of
57.64 - Some ((eq, ct), ps) => (* binding already generated *)
57.65 + SOME ((eq, ct), ps) => (* binding already generated *)
57.66 if mkeq andalso eq="" then
57.67 let val eq' = variant vs "eq"
57.68 in ((eq' :: vs, overwrite (vals,
57.69 (t, ((eq', ct), ps @ [mk_refleq eq' ct])))), (eq', ct))
57.70 end
57.71 else ((vs, vals), (eq, ct))
57.72 - | None => (case assoc (ts, t) of
57.73 - Some v => (* atomic term *)
57.74 + | NONE => (case assoc (ts, t) of
57.75 + SOME v => (* atomic term *)
57.76 let val xs = if not (null (term_tvars t)) andalso is_Const t then
57.77 [mk_val [v] [inst_ty false ty_bs t v]] else []
57.78 in
57.79 @@ -240,10 +240,10 @@
57.80 else ((vs, if null xs then vals else vals @
57.81 [(t, (("", v), xs))]), ("", v))
57.82 end
57.83 - | None => (* complex term *)
57.84 + | NONE => (* complex term *)
57.85 let val (f as Const (cname, _), us) = strip_comb t
57.86 in case Symtab.lookup (case_tab, cname) of
57.87 - Some cases => (* case expression *)
57.88 + SOME cases => (* case expression *)
57.89 let
57.90 val (us', u) = split_last us;
57.91 val b = unint sg fs u;
57.92 @@ -329,7 +329,7 @@
57.93 end
57.94 end
57.95
57.96 - | None =>
57.97 + | NONE =>
57.98 let
57.99 val b = forall (unint sg fs) us;
57.100 val (q, eqs) = foldl_map
57.101 @@ -345,18 +345,18 @@
57.102 (Pretty.str eqf) (map (Pretty.str o fst) eqs)
57.103 in
57.104 case (lookup sg fs f, b) of
57.105 - (None, true) => (* completely uninterpreted *)
57.106 + (NONE, true) => (* completely uninterpreted *)
57.107 if mkeq then ((ct :: eq :: vs', vals' @
57.108 [(t, ((eq, ct), [ctv, mk_refleq eq ct]))]), (eq, ct))
57.109 else ((ct :: vs', vals' @ [(t, (("", ct), [ctv]))]), ("", ct))
57.110 - | (None, false) => (* function uninterpreted *)
57.111 + | (NONE, false) => (* function uninterpreted *)
57.112 ((eq :: ct :: vs', vals' @
57.113 [(t, ((eq, ct), [ctv, mk_val [eq] [combp false]]))]), (eq, ct))
57.114 - | (Some (s, _, _), true) => (* arguments uninterpreted *)
57.115 + | (SOME (s, _, _), true) => (* arguments uninterpreted *)
57.116 ((eq :: ct :: vs', vals' @
57.117 [(t, ((eq, ct), [mk_val [ct, eq] (separate (Pretty.brk 1)
57.118 (Pretty.str s :: map (Pretty.str o snd) eqs))]))]), (eq, ct))
57.119 - | (Some (s, _, _), false) => (* function and arguments interpreted *)
57.120 + | (SOME (s, _, _), false) => (* function and arguments interpreted *)
57.121 let val eq' = variant (eq :: ct :: vs') "eq"
57.122 in ((eq' :: eq :: ct :: vs', vals' @ [(t, ((eq', ct),
57.123 [mk_val [ct, eq] (separate (Pretty.brk 1)
57.124 @@ -373,8 +373,8 @@
57.125 fun mk_funs_code sg case_tab fs fs' =
57.126 let
57.127 val case_thms = mapfilter (fn s => (case Symtab.lookup (case_tab, s) of
57.128 - None => None
57.129 - | Some thms => Some (unsuffix "_case" (Sign.base_name s) ^ ".cases",
57.130 + NONE => NONE
57.131 + | SOME thms => SOME (unsuffix "_case" (Sign.base_name s) ^ ".cases",
57.132 map (fn i => Sign.base_name s ^ "_" ^ string_of_int i)
57.133 (1 upto length thms) ~~ thms)))
57.134 (foldr add_term_consts (map (prop_of o snd)
57.135 @@ -423,7 +423,7 @@
57.136
57.137 val default = if d then
57.138 let
57.139 - val Some s = assoc (thm_bs, f);
57.140 + val SOME s = assoc (thm_bs, f);
57.141 val ct = variant vs' "ct"
57.142 in [Pretty.brk 1, Pretty.str "handle", Pretty.brk 1,
57.143 Pretty.str "Match =>", Pretty.brk 1, mk_let "let" 2
58.1 --- a/src/HOL/Matrix/fspmlp.ML Fri Feb 11 18:51:00 2005 +0100
58.2 +++ b/src/HOL/Matrix/fspmlp.ML Sun Feb 13 17:15:14 2005 +0100
58.3 @@ -47,12 +47,12 @@
58.4 let
58.5 val x =
58.6 case VarGraph.lookup (g, dest_key) of
58.7 - None => (None, Inttab.update ((row_index, (row_bound, [])), Inttab.empty))
58.8 - | Some (sure_bound, f) =>
58.9 + NONE => (NONE, Inttab.update ((row_index, (row_bound, [])), Inttab.empty))
58.10 + | SOME (sure_bound, f) =>
58.11 (sure_bound,
58.12 case Inttab.lookup (f, row_index) of
58.13 - None => Inttab.update ((row_index, (row_bound, [])), f)
58.14 - | Some _ => raise (Internal "add_row_bound"))
58.15 + NONE => Inttab.update ((row_index, (row_bound, [])), f)
58.16 + | SOME _ => raise (Internal "add_row_bound"))
58.17 in
58.18 VarGraph.update ((dest_key, x), g)
58.19 end
58.20 @@ -61,10 +61,10 @@
58.21 let
58.22 val x =
58.23 case VarGraph.lookup (g, key) of
58.24 - None => (Some bound, Inttab.empty)
58.25 - | Some (None, f) => (Some bound, f)
58.26 - | Some (Some old_bound, f) =>
58.27 - (Some ((case btype of
58.28 + NONE => (SOME bound, Inttab.empty)
58.29 + | SOME (NONE, f) => (SOME bound, f)
58.30 + | SOME (SOME old_bound, f) =>
58.31 + (SOME ((case btype of
58.32 UPPER => FloatArith.min
58.33 | LOWER => FloatArith.max)
58.34 old_bound bound), f)
58.35 @@ -74,32 +74,32 @@
58.36
58.37 fun get_sure_bound g key =
58.38 case VarGraph.lookup (g, key) of
58.39 - None => None
58.40 - | Some (sure_bound, _) => sure_bound
58.41 + NONE => NONE
58.42 + | SOME (sure_bound, _) => sure_bound
58.43
58.44 (*fun get_row_bound g key row_index =
58.45 case VarGraph.lookup (g, key) of
58.46 - None => None
58.47 - | Some (sure_bound, f) =>
58.48 + NONE => NONE
58.49 + | SOME (sure_bound, f) =>
58.50 (case Inttab.lookup (f, row_index) of
58.51 - None => None
58.52 - | Some (row_bound, _) => (sure_bound, row_bound))*)
58.53 + NONE => NONE
58.54 + | SOME (row_bound, _) => (sure_bound, row_bound))*)
58.55
58.56 fun add_edge g src_key dest_key row_index coeff =
58.57 case VarGraph.lookup (g, dest_key) of
58.58 - None => raise (Internal "add_edge: dest_key not found")
58.59 - | Some (sure_bound, f) =>
58.60 + NONE => raise (Internal "add_edge: dest_key not found")
58.61 + | SOME (sure_bound, f) =>
58.62 (case Inttab.lookup (f, row_index) of
58.63 - None => raise (Internal "add_edge: row_index not found")
58.64 - | Some (row_bound, sources) =>
58.65 + NONE => raise (Internal "add_edge: row_index not found")
58.66 + | SOME (row_bound, sources) =>
58.67 VarGraph.update ((dest_key, (sure_bound, Inttab.update ((row_index, (row_bound, (coeff, src_key) :: sources)), f))), g))
58.68
58.69 fun split_graph g =
58.70 let
58.71 fun split ((r1, r2), (key, (sure_bound, _))) =
58.72 case sure_bound of
58.73 - None => (r1, r2)
58.74 - | Some bound =>
58.75 + NONE => (r1, r2)
58.76 + | SOME bound =>
58.77 (case key of
58.78 (u, UPPER) => (r1, Inttab.update ((u, bound), r2))
58.79 | (u, LOWER) => (Inttab.update ((u, bound), r1), r2))
58.80 @@ -118,7 +118,7 @@
58.81 If safe is false, termination is not guaranteed, but on termination the sure bounds are optimal (relative to the algorithm) *)
58.82 fun propagate_sure_bounds safe names g =
58.83 let
58.84 - (* returns None if no new sure bound could be calculated, otherwise the new sure bound is returned *)
58.85 + (* returns NONE if no new sure bound could be calculated, otherwise the new sure bound is returned *)
58.86 fun calc_sure_bound_from_sources g (key as (_, btype)) =
58.87 let
58.88 fun mult_upper x (lower, upper) =
58.89 @@ -139,40 +139,40 @@
58.90 let
58.91 fun add_src_bound (sum, (coeff, src_key)) =
58.92 case sum of
58.93 - None => None
58.94 - | Some x =>
58.95 + NONE => NONE
58.96 + | SOME x =>
58.97 (case get_sure_bound g src_key of
58.98 - None => None
58.99 - | Some src_sure_bound => Some (FloatArith.add x (mult_btype src_sure_bound coeff)))
58.100 + NONE => NONE
58.101 + | SOME src_sure_bound => SOME (FloatArith.add x (mult_btype src_sure_bound coeff)))
58.102 in
58.103 - case foldl add_src_bound (Some row_bound, sources) of
58.104 - None => sure_bound
58.105 - | new_sure_bound as (Some new_bound) =>
58.106 + case foldl add_src_bound (SOME row_bound, sources) of
58.107 + NONE => sure_bound
58.108 + | new_sure_bound as (SOME new_bound) =>
58.109 (case sure_bound of
58.110 - None => new_sure_bound
58.111 - | Some old_bound =>
58.112 - Some (case btype of
58.113 + NONE => new_sure_bound
58.114 + | SOME old_bound =>
58.115 + SOME (case btype of
58.116 UPPER => FloatArith.min old_bound new_bound
58.117 | LOWER => FloatArith.max old_bound new_bound))
58.118 end
58.119 in
58.120 case VarGraph.lookup (g, key) of
58.121 - None => None
58.122 - | Some (sure_bound, f) =>
58.123 + NONE => NONE
58.124 + | SOME (sure_bound, f) =>
58.125 let
58.126 val x = Inttab.foldl calc_sure_bound (sure_bound, f)
58.127 in
58.128 - if x = sure_bound then None else x
58.129 + if x = sure_bound then NONE else x
58.130 end
58.131 end
58.132
58.133 fun propagate ((g, b), (key, _)) =
58.134 case calc_sure_bound_from_sources g key of
58.135 - None => (g,b)
58.136 - | Some bound => (update_sure_bound g key bound,
58.137 + NONE => (g,b)
58.138 + | SOME bound => (update_sure_bound g key bound,
58.139 if safe then
58.140 case get_sure_bound g key of
58.141 - None => true
58.142 + NONE => true
58.143 | _ => b
58.144 else
58.145 true)
58.146 @@ -203,7 +203,7 @@
58.147 fun calcr (g, (row_index, a)) =
58.148 let
58.149 val b = FloatSparseMatrixBuilder.v_elem_at b row_index
58.150 - val (_, b2) = ExactFloatingPoint.approx_decstr_by_bin prec (case b of None => "0" | Some b => b)
58.151 + val (_, b2) = ExactFloatingPoint.approx_decstr_by_bin prec (case b of NONE => "0" | SOME b => b)
58.152 val approx_a = FloatSparseMatrixBuilder.v_fold (fn (l, (i,s)) =>
58.153 (i, ExactFloatingPoint.approx_decstr_by_bin prec s)::l) [] a
58.154
58.155 @@ -265,8 +265,8 @@
58.156 let
58.157 val index = xlen-i
58.158 val r = abs_estimate (i-1) r1 r2
58.159 - val b1 = case Inttab.lookup (r1, index) of None => raise (Load ("x-value not bounded from below: "^(names index))) | Some x => x
58.160 - val b2 = case Inttab.lookup (r2, index) of None => raise (Load ("x-value not bounded from above: "^(names index))) | Some x => x
58.161 + val b1 = case Inttab.lookup (r1, index) of NONE => raise (Load ("x-value not bounded from below: "^(names index))) | SOME x => x
58.162 + val b2 = case Inttab.lookup (r2, index) of NONE => raise (Load ("x-value not bounded from above: "^(names index))) | SOME x => x
58.163 val abs_max = FloatArith.max (FloatArith.neg (FloatArith.negative_part b1)) (FloatArith.positive_part b2)
58.164 val vec = FloatSparseMatrixBuilder.cons_spvec (FloatSparseMatrixBuilder.mk_spvec_entry 0 abs_max) FloatSparseMatrixBuilder.empty_spvec
58.165 in
58.166 @@ -287,7 +287,7 @@
58.167 val (dualprog, indexof) = FloatSparseMatrixBuilder.dual_cplexProg c A b
58.168 val results = Cplex.solve dualprog
58.169 val (optimal,v) = CplexFloatSparseMatrixConverter.convert_results results indexof
58.170 - val A = FloatSparseMatrixBuilder.cut_matrix v None A
58.171 + val A = FloatSparseMatrixBuilder.cut_matrix v NONE A
58.172 fun id x = x
58.173 val v = FloatSparseMatrixBuilder.set_vector FloatSparseMatrixBuilder.empty_matrix 0 v
58.174 val b = FloatSparseMatrixBuilder.transpose_matrix (FloatSparseMatrixBuilder.set_vector FloatSparseMatrixBuilder.empty_matrix 0 b)
59.1 --- a/src/HOL/MicroJava/J/JListExample.thy Fri Feb 11 18:51:00 2005 +0100
59.2 +++ b/src/HOL/MicroJava/J/JListExample.thy Sun Feb 13 17:15:14 2005 +0100
59.3 @@ -109,7 +109,7 @@
59.4
59.5 ML {*
59.6
59.7 -val Library.Some ((_, (heap, locs)), _) = Seq.pull test;
59.8 +val SOME ((_, (heap, locs)), _) = Seq.pull test;
59.9 locs l1_name;
59.10 locs l2_name;
59.11 locs l3_name;
60.1 --- a/src/HOL/Modelcheck/EindhovenSyn.ML Fri Feb 11 18:51:00 2005 +0100
60.2 +++ b/src/HOL/Modelcheck/EindhovenSyn.ML Sun Feb 13 17:15:14 2005 +0100
60.3 @@ -26,7 +26,7 @@
60.4
60.5 val pair_eta_expand_proc =
60.6 Simplifier.simproc (Theory.sign_of (the_context ())) "pair_eta_expand" ["f::'a*'b=>'c"]
60.7 - (fn _ => fn _ => fn t => case t of Abs _ => Some (mk_meta_eq pair_eta_expand) | _ => None);
60.8 + (fn _ => fn _ => fn t => case t of Abs _ => SOME (mk_meta_eq pair_eta_expand) | _ => NONE);
60.9
60.10 val Eindhoven_ss =
60.11 simpset() addsimprocs [pair_eta_expand_proc] addsimps [Let_def];
61.1 --- a/src/HOL/Modelcheck/MuckeSyn.ML Fri Feb 11 18:51:00 2005 +0100
61.2 +++ b/src/HOL/Modelcheck/MuckeSyn.ML Sun Feb 13 17:15:14 2005 +0100
61.3 @@ -1,22 +1,22 @@
61.4 (* search_mu t searches for Mu terms in term t. In the case of nested Mu's,
61.5 - it yields innermost one. If no Mu term is present, search_mu yields None
61.6 + it yields innermost one. If no Mu term is present, search_mu yields NONE
61.7 *)
61.8
61.9 (* extended for treatment of nu (TH) *)
61.10 fun search_mu ((Const("MuCalculus.mu",tp)) $ t2) =
61.11 (case (search_mu t2) of
61.12 - Some t => Some t
61.13 - | None => Some ((Const("MuCalculus.mu",tp)) $ t2))
61.14 + SOME t => SOME t
61.15 + | NONE => SOME ((Const("MuCalculus.mu",tp)) $ t2))
61.16 | search_mu ((Const("MuCalculus.nu",tp)) $ t2) =
61.17 (case (search_mu t2) of
61.18 - Some t => Some t
61.19 - | None => Some ((Const("MuCalculus.nu",tp)) $ t2))
61.20 + SOME t => SOME t
61.21 + | NONE => SOME ((Const("MuCalculus.nu",tp)) $ t2))
61.22 | search_mu (t1 $ t2) =
61.23 (case (search_mu t1) of
61.24 - Some t => Some t
61.25 - | None => search_mu t2)
61.26 + SOME t => SOME t
61.27 + | NONE => search_mu t2)
61.28 | search_mu (Abs(_,_,t)) = search_mu t
61.29 - | search_mu _ = None;
61.30 + | search_mu _ = NONE;
61.31
61.32
61.33
61.34 @@ -27,11 +27,11 @@
61.35 fun search_var s t =
61.36 case t of
61.37 t1 $ t2 => (case (search_var s t1) of
61.38 - Some tt => Some tt |
61.39 - None => search_var s t2) |
61.40 + SOME tt => SOME tt |
61.41 + NONE => search_var s t2) |
61.42 Abs(_,_,t) => search_var s t |
61.43 - Var((s1,_),_) => if s = s1 then Some t else None |
61.44 - _ => None;
61.45 + Var((s1,_),_) => if s = s1 then SOME t else NONE |
61.46 + _ => NONE;
61.47
61.48
61.49 (* function move_mus:
61.50 @@ -65,8 +65,8 @@
61.51 if t < 0 then 1 else t+1 end;
61.52 in
61.53 case redex of
61.54 - None => all_tac state |
61.55 - Some redexterm =>
61.56 + NONE => all_tac state |
61.57 + SOME redexterm =>
61.58 let val Credex = cterm_of sign redexterm;
61.59 val aiCterm =
61.60 cterm_of sig_move_thm (Logic.incr_indexes ([],idx) (term_of aCterm));
61.61 @@ -99,8 +99,8 @@
61.62
61.63 infix cc;
61.64
61.65 -fun None cc xl = xl
61.66 - | (Some x) cc xl = x::xl;
61.67 +fun NONE cc xl = xl
61.68 + | (SOME x) cc xl = x::xl;
61.69
61.70 fun getargs ((x $ y) $ (Var ((z,_),_))) = getargs (x $ y) ^ " " ^z
61.71 | getargs (x $ (Var ((y,_),_))) = y;
61.72 @@ -126,18 +126,18 @@
61.73 in
61.74
61.75 (* extension with removing bold font (TH) *)
61.76 -fun mk_lam_def (_::_) _ _ = None
61.77 - | mk_lam_def [] ((Const("==",_) $ (Const _)) $ RHS) t = Some t
61.78 +fun mk_lam_def (_::_) _ _ = NONE
61.79 + | mk_lam_def [] ((Const("==",_) $ (Const _)) $ RHS) t = SOME t
61.80 | mk_lam_def [] ((Const("==",_) $ LHS) $ RHS) t =
61.81 let val tsig = #sign (rep_thm t);
61.82 val fnam = Sign.string_of_term tsig (getfun LHS);
61.83 val rhs = Sign.string_of_term tsig (freeze_thaw RHS)
61.84 val gl = delete_bold_string (fnam ^" == % " ^ (getargs LHS) ^" . " ^ rhs);
61.85 in
61.86 - Some (prove_goal (theory_of_sign tsig) gl (fn prems =>
61.87 + SOME (prove_goal (theory_of_sign tsig) gl (fn prems =>
61.88 [(REPEAT (rtac ext_rl 1)), (rtac t 1) ]))
61.89 end
61.90 -| mk_lam_def [] _ t= None;
61.91 +| mk_lam_def [] _ t= NONE;
61.92
61.93 fun mk_lam_defs ([]:thm list) = ([]: thm list)
61.94 | mk_lam_defs (t::l) =
61.95 @@ -157,8 +157,8 @@
61.96 Simplifier.simproc (Theory.sign_of (the_context ()))
61.97 "pair_eta_expand" ["f::'a*'b=>'c"]
61.98 (fn _ => fn _ => fn t =>
61.99 - case t of Abs _ => Some (mk_meta_eq pair_eta_expand)
61.100 - | _ => None);
61.101 + case t of Abs _ => SOME (mk_meta_eq pair_eta_expand)
61.102 + | _ => NONE);
61.103
61.104 val Mucke_ss = simpset() addsimprocs [pair_eta_expand_proc] addsimps [Let_def];
61.105
62.1 --- a/src/HOL/Modelcheck/mucke_oracle.ML Fri Feb 11 18:51:00 2005 +0100
62.2 +++ b/src/HOL/Modelcheck/mucke_oracle.ML Sun Feb 13 17:15:14 2005 +0100
62.3 @@ -981,8 +981,8 @@
62.4 val s = post_last_dot(fst(qtn a));
62.5 fun param_types ((Const("Trueprop",_)) $ (_ $ (Var(_,Type(_,t))))) = t |
62.6 param_types _ = error "malformed induct-theorem in preprocess_td";
62.7 - val pl = param_types (concl_of (get_thm (theory_of_sign sg) (s ^ ".induct", None)));
62.8 - val l = split_constrs sg (snd(qtn a)) pl (prems_of (get_thm (theory_of_sign sg) (s ^ ".induct", None)));
62.9 + val pl = param_types (concl_of (get_thm (theory_of_sign sg) (s ^ ".induct", NONE)));
62.10 + val l = split_constrs sg (snd(qtn a)) pl (prems_of (get_thm (theory_of_sign sg) (s ^ ".induct", NONE)));
62.11 val ntl = new_types l;
62.12 in
62.13 ((a,l) :: (preprocess_td sg (ntl @ b) (a :: done)))
63.1 --- a/src/HOL/Orderings.thy Fri Feb 11 18:51:00 2005 +0100
63.2 +++ b/src/HOL/Orderings.thy Sun Feb 13 17:15:14 2005 +0100
63.3 @@ -290,21 +290,21 @@
63.4 let fun of_sort t = Sign.of_sort sign (type_of t, sort)
63.5 fun dec (Const ("Not", _) $ t) = (
63.6 case dec t of
63.7 - None => None
63.8 - | Some (t1, rel, t2) => Some (t1, "~" ^ rel, t2))
63.9 + NONE => NONE
63.10 + | SOME (t1, rel, t2) => SOME (t1, "~" ^ rel, t2))
63.11 | dec (Const ("op =", _) $ t1 $ t2) =
63.12 if of_sort t1
63.13 - then Some (t1, "=", t2)
63.14 - else None
63.15 + then SOME (t1, "=", t2)
63.16 + else NONE
63.17 | dec (Const ("op <=", _) $ t1 $ t2) =
63.18 if of_sort t1
63.19 - then Some (t1, "<=", t2)
63.20 - else None
63.21 + then SOME (t1, "<=", t2)
63.22 + else NONE
63.23 | dec (Const ("op <", _) $ t1 $ t2) =
63.24 if of_sort t1
63.25 - then Some (t1, "<", t2)
63.26 - else None
63.27 - | dec _ = None
63.28 + then SOME (t1, "<", t2)
63.29 + else NONE
63.30 + | dec _ = NONE
63.31 in dec t end;
63.32
63.33 structure Quasi_Tac = Quasi_Tac_Fun (
64.1 --- a/src/HOL/Product_Type.thy Fri Feb 11 18:51:00 2005 +0100
64.2 +++ b/src/HOL/Product_Type.thy Sun Feb 13 17:15:14 2005 +0100
64.3 @@ -34,7 +34,7 @@
64.4 val unit_eq_proc =
64.5 let val unit_meta_eq = mk_meta_eq (thm "unit_eq") in
64.6 Simplifier.simproc (Theory.sign_of (the_context ())) "unit_eq" ["x::unit"]
64.7 - (fn _ => fn _ => fn t => if HOLogic.is_unit t then None else Some unit_meta_eq)
64.8 + (fn _ => fn _ => fn t => if HOLogic.is_unit t then NONE else SOME unit_meta_eq)
64.9 end;
64.10
64.11 Addsimprocs [unit_eq_proc];
64.12 @@ -409,9 +409,9 @@
64.13 | no_args k i (t $ u) = no_args k i t andalso no_args k i u
64.14 | no_args k i (Bound m) = m < k orelse m > k+i
64.15 | no_args _ _ _ = true;
64.16 - fun split_pat tp i (Abs (_,_,t)) = if tp 0 i t then Some (i,t) else None
64.17 + fun split_pat tp i (Abs (_,_,t)) = if tp 0 i t then SOME (i,t) else NONE
64.18 | split_pat tp i (Const ("split", _) $ Abs (_, _, t)) = split_pat tp (i+1) t
64.19 - | split_pat tp i _ = None;
64.20 + | split_pat tp i _ = NONE;
64.21 fun metaeq sg lhs rhs = mk_meta_eq (Tactic.prove sg [] []
64.22 (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,rhs)))
64.23 (K (simp_tac (HOL_basic_ss addsimps [cond_split_eta]) 1)));
64.24 @@ -428,14 +428,14 @@
64.25 | subst arg k i t = t;
64.26 fun beta_proc sg _ (s as Const ("split", _) $ Abs (_, _, t) $ arg) =
64.27 (case split_pat beta_term_pat 1 t of
64.28 - Some (i,f) => Some (metaeq sg s (subst arg 0 i f))
64.29 - | None => None)
64.30 - | beta_proc _ _ _ = None;
64.31 + SOME (i,f) => SOME (metaeq sg s (subst arg 0 i f))
64.32 + | NONE => NONE)
64.33 + | beta_proc _ _ _ = NONE;
64.34 fun eta_proc sg _ (s as Const ("split", _) $ Abs (_, _, t)) =
64.35 (case split_pat eta_term_pat 1 t of
64.36 - Some (_,ft) => Some (metaeq sg s (let val (f $ arg) = ft in f end))
64.37 - | None => None)
64.38 - | eta_proc _ _ _ = None;
64.39 + SOME (_,ft) => SOME (metaeq sg s (let val (f $ arg) = ft in f end))
64.40 + | NONE => NONE)
64.41 + | eta_proc _ _ _ = NONE;
64.42 in
64.43 val split_beta_proc = Simplifier.simproc (Theory.sign_of (the_context ()))
64.44 "split_beta" ["split f z"] beta_proc;
64.45 @@ -810,13 +810,13 @@
64.46 val (gr2, pr) = Codegen.invoke_codegen thy dep false (gr1, r);
64.47 in (gr2, (pl, pr)) end
64.48 in case dest_let t of
64.49 - ([], _) => None
64.50 + ([], _) => NONE
64.51 | (ps, u) =>
64.52 let
64.53 val (gr1, qs) = foldl_map mk_code (gr, ps);
64.54 val (gr2, pu) = Codegen.invoke_codegen thy dep false (gr1, u)
64.55 in
64.56 - Some (gr2, Pretty.blk (0, [Pretty.str "let ", Pretty.blk (0, flat
64.57 + SOME (gr2, Pretty.blk (0, [Pretty.str "let ", Pretty.blk (0, flat
64.58 (separate [Pretty.str ";", Pretty.brk 1] (map (fn (pl, pr) =>
64.59 [Pretty.block [Pretty.str "val ", pl, Pretty.str " =",
64.60 Pretty.brk 1, pr]]) qs))),
64.61 @@ -824,7 +824,7 @@
64.62 Pretty.brk 1, Pretty.str "end"]))
64.63 end
64.64 end
64.65 - | let_codegen thy gr dep brack t = None;
64.66 + | let_codegen thy gr dep brack t = NONE;
64.67
64.68 fun split_codegen thy gr dep brack (t as Const ("split", _) $ _) =
64.69 (case strip_abs 1 t of
64.70 @@ -833,11 +833,11 @@
64.71 val (gr1, q) = Codegen.invoke_codegen thy dep false (gr, p);
64.72 val (gr2, pu) = Codegen.invoke_codegen thy dep false (gr1, u)
64.73 in
64.74 - Some (gr2, Pretty.block [Pretty.str "(fn ", q, Pretty.str " =>",
64.75 + SOME (gr2, Pretty.block [Pretty.str "(fn ", q, Pretty.str " =>",
64.76 Pretty.brk 1, pu, Pretty.str ")"])
64.77 end
64.78 - | _ => None)
64.79 - | split_codegen thy gr dep brack t = None;
64.80 + | _ => NONE)
64.81 + | split_codegen thy gr dep brack t = NONE;
64.82
64.83 in
64.84
65.1 --- a/src/HOL/Real/real_arith.ML Fri Feb 11 18:51:00 2005 +0100
65.2 +++ b/src/HOL/Real/real_arith.ML Sun Feb 13 17:15:14 2005 +0100
65.3 @@ -136,7 +136,7 @@
65.4 end;
65.5
65.6
65.7 -(* Some test data [omitting examples that assume the ordering to be discrete!]
65.8 +(* SOME test data [omitting examples that assume the ordering to be discrete!]
65.9 Goal "!!a::real. [| a <= b; c <= d; x+y<z |] ==> a+c <= b+d";
65.10 by (fast_arith_tac 1);
65.11 qed "";
66.1 --- a/src/HOL/TLA/TLA.ML Fri Feb 11 18:51:00 2005 +0100
66.2 +++ b/src/HOL/TLA/TLA.ML Sun Feb 13 17:15:14 2005 +0100
66.3 @@ -818,7 +818,7 @@
66.4 by (asm_simp_tac (simpset() addsimps [split_box_conj,box_stp_actI]) 1);
66.5 qed "WF1";
66.6
66.7 -(* Sometimes easier to use; designed for action B rather than state predicate Q *)
66.8 +(* SOMEtimes easier to use; designed for action B rather than state predicate Q *)
66.9 val [prem1,prem2,prem3] = goalw thy [leadsto_def]
66.10 "[| |- N & $P --> $Enabled (<A>_v); \
66.11 \ |- N & <A>_v --> B; \
67.1 --- a/src/HOL/Tools/Presburger/cooper_dec.ML Fri Feb 11 18:51:00 2005 +0100
67.2 +++ b/src/HOL/Tools/Presburger/cooper_dec.ML Sun Feb 13 17:15:14 2005 +0100
67.3 @@ -92,7 +92,7 @@
67.4 fun dest_numeral (Const("0",Type ("IntDef.int", []))) = 0
67.5 |dest_numeral (Const("1",Type ("IntDef.int", []))) = 1
67.6 |dest_numeral (Const ("Numeral.number_of",_) $ n)= HOLogic.dest_binum n;
67.7 -(*Some terms often used for pattern matching*)
67.8 +(*SOME terms often used for pattern matching*)
67.9
67.10 val zero = mk_numeral 0;
67.11 val one = mk_numeral 1;
67.12 @@ -450,7 +450,7 @@
67.13 [("op =",op=), ("op <",op<), ("op >",op>), ("op <=",op<=) , ("op >=",op>=),
67.14 ("Divides.op dvd",fn (x,y) =>((y mod x) = 0))];
67.15
67.16 -fun applyoperation (Some f) (a,b) = f (a, b)
67.17 +fun applyoperation (SOME f) (a,b) = f (a, b)
67.18 |applyoperation _ (_, _) = false;
67.19
67.20 (*Evaluation of constant atomic formulas*)
67.21 @@ -464,12 +464,12 @@
67.22 handle _ => at)
67.23 else
67.24 case assoc (operations,p) of
67.25 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
67.26 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
67.27 handle _ => at)
67.28 | _ => at)
67.29 |Const("Not",_)$(Const (p,_) $ s $ t) =>(
67.30 case assoc (operations,p) of
67.31 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then
67.32 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then
67.33 HOLogic.false_const else HOLogic.true_const)
67.34 handle _ => at)
67.35 | _ => at)
67.36 @@ -480,12 +480,12 @@
67.37 fun evalc_atom at = case at of
67.38 (Const (p,_) $ s $ t) =>
67.39 ( case assoc (operations,p) of
67.40 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
67.41 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then HOLogic.true_const else HOLogic.false_const)
67.42 handle _ => at)
67.43 | _ => at)
67.44 |Const("Not",_)$(Const (p,_) $ s $ t) =>(
67.45 case assoc (operations,p) of
67.46 - Some f => ((if (f ((dest_numeral s),(dest_numeral t))) then
67.47 + SOME f => ((if (f ((dest_numeral s),(dest_numeral t))) then
67.48 HOLogic.false_const else HOLogic.true_const)
67.49 handle _ => at)
67.50 | _ => at)
67.51 @@ -711,14 +711,14 @@
67.52 fun inf_w mi d vars x p =
67.53 let val f = if mi then minusinf else plusinf in
67.54 case (simpl (minusinf x p)) of
67.55 - Const("True",_) => (Some (mk_numeral 1), HOLogic.true_const)
67.56 - |Const("False",_) => (None,HOLogic.false_const)
67.57 + Const("True",_) => (SOME (mk_numeral 1), HOLogic.true_const)
67.58 + |Const("False",_) => (NONE,HOLogic.false_const)
67.59 |F =>
67.60 let
67.61 fun h n =
67.62 case ((simpl o evalc) (linrep vars x (mk_numeral n) F)) of
67.63 - Const("True",_) => (Some (mk_numeral n),HOLogic.true_const)
67.64 - |F' => if n=1 then (None,F')
67.65 + Const("True",_) => (SOME (mk_numeral n),HOLogic.true_const)
67.66 + |F' => if n=1 then (NONE,F')
67.67 else let val (rw,rf) = h (n-1) in
67.68 (rw,HOLogic.mk_disj(F',rf))
67.69 end
67.70 @@ -729,9 +729,9 @@
67.71
67.72 fun set_w d b st vars x p = let
67.73 fun h ns = case ns of
67.74 - [] => (None,HOLogic.false_const)
67.75 + [] => (NONE,HOLogic.false_const)
67.76 |n::nl => ( case ((simpl o evalc) (linrep vars x n p)) of
67.77 - Const("True",_) => (Some n,HOLogic.true_const)
67.78 + Const("True",_) => (SOME n,HOLogic.true_const)
67.79 |F' => let val (rw,rf) = h nl
67.80 in (rw,HOLogic.mk_disj(F',rf))
67.81 end)
67.82 @@ -741,10 +741,10 @@
67.83 end;
67.84
67.85 fun withness d b st vars x p = case (inf_w b d vars x p) of
67.86 - (Some n,_) => (Some n,HOLogic.true_const)
67.87 - |(None,Pinf) => (case (set_w d b st vars x p) of
67.88 - (Some n,_) => (Some n,HOLogic.true_const)
67.89 - |(_,Pst) => (None,HOLogic.mk_disj(Pinf,Pst)));
67.90 + (SOME n,_) => (SOME n,HOLogic.true_const)
67.91 + |(NONE,Pinf) => (case (set_w d b st vars x p) of
67.92 + (SOME n,_) => (SOME n,HOLogic.true_const)
67.93 + |(_,Pst) => (NONE,HOLogic.mk_disj(Pinf,Pst)));
67.94
67.95
67.96
68.1 --- a/src/HOL/Tools/Presburger/cooper_proof.ML Fri Feb 11 18:51:00 2005 +0100
68.2 +++ b/src/HOL/Tools/Presburger/cooper_proof.ML Sun Feb 13 17:15:14 2005 +0100
68.3 @@ -194,8 +194,8 @@
68.4
68.5 fun simple_prove_goal_cterm2 G tacs =
68.6 let
68.7 - fun check None = error "prove_goal: tactic failed"
68.8 - | check (Some (thm, _)) = (case nprems_of thm of
68.9 + fun check NONE = error "prove_goal: tactic failed"
68.10 + | check (SOME (thm, _)) = (case nprems_of thm of
68.11 0 => thm
68.12 | i => !result_error_fn thm (string_of_int i ^ " unsolved goals!"))
68.13 in check (Seq.pull (EVERY tacs (trivial G))) end;
68.14 @@ -320,7 +320,7 @@
68.15 val cx = cterm_of sg y
68.16 val pre = prove_elementar sg "lf"
68.17 (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),(mk_numeral n)))
68.18 - val th1 = (pre RS (instantiate' [] [Some ck,Some cc, Some cx, Some ct] (ac_pi_eq)))
68.19 + val th1 = (pre RS (instantiate' [] [SOME ck,SOME cc, SOME cx, SOME ct] (ac_pi_eq)))
68.20 in ([], fn [] => [th1,(prove_elementar sg "sa" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
68.21 end
68.22
68.23 @@ -344,32 +344,32 @@
68.24 "op <" =>
68.25 let val pre = prove_elementar sg "lf"
68.26 (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),(mk_numeral k)))
68.27 - val th1 = (pre RS (instantiate' [] [Some ck,Some ca,Some cc, Some cx, Some ct] (ac_lt_eq)))
68.28 + val th1 = (pre RS (instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct] (ac_lt_eq)))
68.29 in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
68.30 end
68.31
68.32 |"op =" =>
68.33 let val pre = prove_elementar sg "lf"
68.34 (HOLogic.Not $ (HOLogic.mk_binrel "op =" (Const("0",HOLogic.intT),(mk_numeral k))))
68.35 - val th1 = (pre RS(instantiate' [] [Some ck,Some ca,Some cc, Some cx, Some ct] (ac_eq_eq)))
68.36 + val th1 = (pre RS(instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct] (ac_eq_eq)))
68.37 in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
68.38 end
68.39
68.40 |"Divides.op dvd" =>
68.41 let val pre = prove_elementar sg "lf"
68.42 (HOLogic.Not $ (HOLogic.mk_binrel "op =" (Const("0",HOLogic.intT),(mk_numeral k))))
68.43 - val th1 = (pre RS (instantiate' [] [Some ck,Some ca,Some cc, Some cx, Some ct]) (ac_dvd_eq))
68.44 + val th1 = (pre RS (instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct]) (ac_dvd_eq))
68.45 in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
68.46
68.47 end
68.48 end
68.49 - else ([], fn [] => instantiate' [Some cboolT] [Some (cterm_of sg fm)] refl)
68.50 + else ([], fn [] => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] refl)
68.51
68.52 |( Const ("Not", _) $ p) => ([p], fn [th] => th RS qe_Not)
68.53 |( Const ("op &",_) $ p $ q) => ([p,q], fn [th1,th2] => [th1,th2] MRS qe_conjI)
68.54 |( Const ("op |",_) $ p $ q) =>([p,q], fn [th1,th2] => [th1,th2] MRS qe_disjI)
68.55
68.56 - |_ => ([], fn [] => instantiate' [Some cboolT] [Some (cterm_of sg fm)] refl);
68.57 + |_ => ([], fn [] => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] refl);
68.58
68.59 fun proof_of_adjustcoeffeq sg x l = thm_of sg (decomp_adjustcoeffeq sg x l);
68.60
68.61 @@ -380,43 +380,43 @@
68.62 (*==================================================*)
68.63 fun rho_for_modd_minf x dlcm sg fm1 =
68.64 let
68.65 - (*Some certified Terms*)
68.66 + (*SOME certified Terms*)
68.67
68.68 val ctrue = cterm_of sg HOLogic.true_const
68.69 val cfalse = cterm_of sg HOLogic.false_const
68.70 val fm = norm_zero_one fm1
68.71 in case fm1 of
68.72 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
68.73 - if (x=y) andalso (c1= zero) andalso (c2= one) then (instantiate' [Some cboolT] [Some ctrue] (fm_modd_minf))
68.74 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
68.75 + if (x=y) andalso (c1= zero) andalso (c2= one) then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_minf))
68.76 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
68.77
68.78 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
68.79 if (is_arith_rel fm) andalso (x=y) andalso (c1= zero) andalso (c2= one)
68.80 - then (instantiate' [Some cboolT] [Some cfalse] (fm_modd_minf))
68.81 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
68.82 + then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_minf))
68.83 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
68.84
68.85 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
68.86 if (y=x) andalso (c1 = zero) then
68.87 - if (pm1 = one) then (instantiate' [Some cboolT] [Some cfalse] (fm_modd_minf)) else
68.88 - (instantiate' [Some cboolT] [Some ctrue] (fm_modd_minf))
68.89 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
68.90 + if (pm1 = one) then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_minf)) else
68.91 + (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_minf))
68.92 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
68.93
68.94 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.95 if y=x then let val cz = cterm_of sg (norm_zero_one z)
68.96 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
68.97 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_minf)))
68.98 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_minf)))
68.99 end
68.100 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
68.101 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
68.102 |(Const("Divides.op dvd",_)$ d $ (db as (Const ("op +",_) $ (Const ("op *",_) $
68.103 c $ y ) $ z))) =>
68.104 if y=x then let val cz = cterm_of sg (norm_zero_one z)
68.105 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
68.106 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_minf)))
68.107 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_minf)))
68.108 end
68.109 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf))
68.110 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
68.111
68.112
68.113 - |_ => instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_minf)
68.114 + |_ => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf)
68.115 end;
68.116 (*=========================================================================*)
68.117 (*=========================================================================*)
68.118 @@ -426,36 +426,36 @@
68.119 in case fm1 of
68.120 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
68.121 if (x=y) andalso (c1=zero) andalso (c2=one)
68.122 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (neq_eq_minf))
68.123 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
68.124 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (neq_eq_minf))
68.125 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
68.126
68.127 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
68.128 if (is_arith_rel fm) andalso (x=y) andalso ((c1=zero) orelse (c1 = norm_zero_one zero)) andalso ((c2=one) orelse (c1 = norm_zero_one one))
68.129 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (eq_eq_minf))
68.130 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
68.131 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (eq_eq_minf))
68.132 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
68.133
68.134 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
68.135 if (y=x) andalso (c1 =zero) then
68.136 - if pm1 = one then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (le_eq_minf)) else
68.137 - (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (len_eq_minf))
68.138 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
68.139 + if pm1 = one then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (le_eq_minf)) else
68.140 + (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (len_eq_minf))
68.141 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
68.142 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.143 if y=x then let val cd = cterm_of sg (norm_zero_one d)
68.144 val cz = cterm_of sg (norm_zero_one z)
68.145 - in(instantiate' [] [Some cd, Some cz] (not_dvd_eq_minf))
68.146 + in(instantiate' [] [SOME cd, SOME cz] (not_dvd_eq_minf))
68.147 end
68.148
68.149 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
68.150 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
68.151
68.152 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.153 if y=x then let val cd = cterm_of sg (norm_zero_one d)
68.154 val cz = cterm_of sg (norm_zero_one z)
68.155 - in(instantiate' [] [Some cd, Some cz ] (dvd_eq_minf))
68.156 + in(instantiate' [] [SOME cd, SOME cz ] (dvd_eq_minf))
68.157 end
68.158 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
68.159 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
68.160
68.161
68.162 - |_ => (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_minf))
68.163 + |_ => (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
68.164 end;
68.165
68.166 (*=====================================================*)
68.167 @@ -476,7 +476,7 @@
68.168 (* -------------------------------------------------------------*)
68.169 fun rho_for_modd_pinf x dlcm sg fm1 =
68.170 let
68.171 - (*Some certified Terms*)
68.172 + (*SOME certified Terms*)
68.173
68.174 val ctrue = cterm_of sg HOLogic.true_const
68.175 val cfalse = cterm_of sg HOLogic.false_const
68.176 @@ -484,37 +484,37 @@
68.177 in case fm1 of
68.178 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
68.179 if ((x=y) andalso (c1= zero) andalso (c2= one))
68.180 - then (instantiate' [Some cboolT] [Some ctrue] (fm_modd_pinf))
68.181 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
68.182 + then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_pinf))
68.183 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
68.184
68.185 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
68.186 if ((is_arith_rel fm) andalso (x = y) andalso (c1 = zero) andalso (c2 = one))
68.187 - then (instantiate' [Some cboolT] [Some cfalse] (fm_modd_pinf))
68.188 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
68.189 + then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_pinf))
68.190 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
68.191
68.192 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
68.193 if ((y=x) andalso (c1 = zero)) then
68.194 if (pm1 = one)
68.195 - then (instantiate' [Some cboolT] [Some ctrue] (fm_modd_pinf))
68.196 - else (instantiate' [Some cboolT] [Some cfalse] (fm_modd_pinf))
68.197 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
68.198 + then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_pinf))
68.199 + else (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_pinf))
68.200 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
68.201
68.202 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.203 if y=x then let val cz = cterm_of sg (norm_zero_one z)
68.204 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
68.205 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_pinf)))
68.206 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_pinf)))
68.207 end
68.208 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
68.209 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
68.210 |(Const("Divides.op dvd",_)$ d $ (db as (Const ("op +",_) $ (Const ("op *",_) $
68.211 c $ y ) $ z))) =>
68.212 if y=x then let val cz = cterm_of sg (norm_zero_one z)
68.213 val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero)
68.214 - in(instantiate' [] [Some cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_pinf)))
68.215 + in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_pinf)))
68.216 end
68.217 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf))
68.218 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
68.219
68.220
68.221 - |_ => instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_modd_pinf)
68.222 + |_ => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf)
68.223 end;
68.224 (* -------------------------------------------------------------*)
68.225 (* Finding rho for pinf_eq *)
68.226 @@ -525,36 +525,36 @@
68.227 in case fm1 of
68.228 (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z))) =>
68.229 if (x=y) andalso (c1=zero) andalso (c2=one)
68.230 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (neq_eq_pinf))
68.231 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
68.232 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (neq_eq_pinf))
68.233 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
68.234
68.235 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ c2 $ y) $z)) =>
68.236 if (is_arith_rel fm) andalso (x=y) andalso ((c1=zero) orelse (c1 = norm_zero_one zero)) andalso ((c2=one) orelse (c1 = norm_zero_one one))
68.237 - then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (eq_eq_pinf))
68.238 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
68.239 + then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (eq_eq_pinf))
68.240 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
68.241
68.242 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
68.243 if (y=x) andalso (c1 =zero) then
68.244 - if pm1 = one then (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (le_eq_pinf)) else
68.245 - (instantiate' [] [Some (cterm_of sg (norm_zero_one z))] (len_eq_pinf))
68.246 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
68.247 + if pm1 = one then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (le_eq_pinf)) else
68.248 + (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (len_eq_pinf))
68.249 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
68.250 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.251 if y=x then let val cd = cterm_of sg (norm_zero_one d)
68.252 val cz = cterm_of sg (norm_zero_one z)
68.253 - in(instantiate' [] [Some cd, Some cz] (not_dvd_eq_pinf))
68.254 + in(instantiate' [] [SOME cd, SOME cz] (not_dvd_eq_pinf))
68.255 end
68.256
68.257 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
68.258 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
68.259
68.260 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.261 if y=x then let val cd = cterm_of sg (norm_zero_one d)
68.262 val cz = cterm_of sg (norm_zero_one z)
68.263 - in(instantiate' [] [Some cd, Some cz ] (dvd_eq_pinf))
68.264 + in(instantiate' [] [SOME cd, SOME cz ] (dvd_eq_pinf))
68.265 end
68.266 - else (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
68.267 + else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
68.268
68.269
68.270 - |_ => (instantiate' [Some cboolT] [Some (cterm_of sg fm)] (fm_eq_pinf))
68.271 + |_ => (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
68.272 end;
68.273
68.274
68.275 @@ -593,7 +593,7 @@
68.276 val cp = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
68.277 val cdlcm = cterm_of sg dlcm
68.278 val cB = cterm_of sg (list_to_set HOLogic.intT (map norm_zero_one bs))
68.279 - in instantiate' [] [Some cdlcm,Some cB, Some cp] (bst_thm)
68.280 + in instantiate' [] [SOME cdlcm,SOME cB, SOME cp] (bst_thm)
68.281 end;
68.282
68.283 fun asetproof_of sg (x as Free(xn,xT)) fm ast dlcm =
68.284 @@ -601,7 +601,7 @@
68.285 val cp = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
68.286 val cdlcm = cterm_of sg dlcm
68.287 val cA = cterm_of sg (list_to_set HOLogic.intT (map norm_zero_one ast))
68.288 - in instantiate' [] [Some cdlcm,Some cA, Some cp] (ast_thm)
68.289 + in instantiate' [] [SOME cdlcm,SOME cA, SOME cp] (ast_thm)
68.290 end;
68.291 *)
68.292
68.293 @@ -623,9 +623,9 @@
68.294 then let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ B)
68.295 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
68.296 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
68.297 - in (instantiate' [] [Some cfma]([th3,th1,th2] MRS (not_bst_p_ne)))
68.298 + in (instantiate' [] [SOME cfma]([th3,th1,th2] MRS (not_bst_p_ne)))
68.299 end
68.300 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
68.301 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
68.302
68.303 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", T) $(Const ("op *",_) $ c2 $ y) $z)) =>
68.304 if (is_arith_rel at) andalso (x=y)
68.305 @@ -633,40 +633,40 @@
68.306 in let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ bst_z $ B)
68.307 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq (bst_z,Const("op -",T) $ (Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)) $ (Const("1",HOLogic.intT))))
68.308 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
68.309 - in (instantiate' [] [Some cfma] ([th3,th1,th2] MRS (not_bst_p_eq)))
68.310 + in (instantiate' [] [SOME cfma] ([th3,th1,th2] MRS (not_bst_p_eq)))
68.311 end
68.312 end
68.313 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
68.314 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
68.315
68.316 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
68.317 if (y=x) andalso (c1 =zero) then
68.318 if pm1 = one then
68.319 let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ B)
68.320 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
68.321 - in (instantiate' [] [Some cfma, Some cdlcm]([th1,th2] MRS (not_bst_p_gt)))
68.322 + in (instantiate' [] [SOME cfma, SOME cdlcm]([th1,th2] MRS (not_bst_p_gt)))
68.323 end
68.324 else let val th1 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
68.325 - in (instantiate' [] [Some cfma, Some cB,Some (cterm_of sg (norm_zero_one z))] (th1 RS (not_bst_p_lt)))
68.326 + in (instantiate' [] [SOME cfma, SOME cB,SOME (cterm_of sg (norm_zero_one z))] (th1 RS (not_bst_p_lt)))
68.327 end
68.328 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
68.329 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
68.330
68.331 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.332 if y=x then
68.333 let val cz = cterm_of sg (norm_zero_one z)
68.334 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
68.335 - in (instantiate' [] [Some cfma, Some cB,Some cz] (th1 RS (not_bst_p_ndvd)))
68.336 + in (instantiate' [] [SOME cfma, SOME cB,SOME cz] (th1 RS (not_bst_p_ndvd)))
68.337 end
68.338 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
68.339 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
68.340
68.341 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.342 if y=x then
68.343 let val cz = cterm_of sg (norm_zero_one z)
68.344 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
68.345 - in (instantiate' [] [Some cfma,Some cB,Some cz] (th1 RS (not_bst_p_dvd)))
68.346 + in (instantiate' [] [SOME cfma,SOME cB,SOME cz] (th1 RS (not_bst_p_dvd)))
68.347 end
68.348 - else (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
68.349 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
68.350
68.351 - |_ => (instantiate' [] [Some cfma, Some cdlcm, Some cB,Some cat] (not_bst_p_fm))
68.352 + |_ => (instantiate' [] [SOME cfma, SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
68.353
68.354 end;
68.355
68.356 @@ -714,9 +714,9 @@
68.357 then let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ A)
68.358 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
68.359 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
68.360 - in (instantiate' [] [Some cfma]([th3,th1,th2] MRS (not_ast_p_ne)))
68.361 + in (instantiate' [] [SOME cfma]([th3,th1,th2] MRS (not_ast_p_ne)))
68.362 end
68.363 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
68.364 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
68.365
68.366 |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const ("op +", T) $(Const ("op *",_) $ c2 $ y) $z)) =>
68.367 if (is_arith_rel at) andalso (x=y)
68.368 @@ -724,39 +724,39 @@
68.369 val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ ast_z $ A)
68.370 val th2 = prove_elementar sg "ss" (HOLogic.mk_eq (ast_z,Const("op +",T) $ (Const("uminus",HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)) $ (Const("1",HOLogic.intT))))
68.371 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
68.372 - in (instantiate' [] [Some cfma] ([th3,th1,th2] MRS (not_ast_p_eq)))
68.373 + in (instantiate' [] [SOME cfma] ([th3,th1,th2] MRS (not_ast_p_eq)))
68.374 end
68.375 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
68.376 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
68.377
68.378 |(Const("op <",_) $ c1 $(Const ("op +", _) $(Const ("op *",_) $ pm1 $ y ) $ z )) =>
68.379 if (y=x) andalso (c1 =zero) then
68.380 if pm1 = (mk_numeral ~1) then
68.381 let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one z) $ A)
68.382 val th2 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (zero,dlcm))
68.383 - in (instantiate' [] [Some cfma]([th2,th1] MRS (not_ast_p_lt)))
68.384 + in (instantiate' [] [SOME cfma]([th2,th1] MRS (not_ast_p_lt)))
68.385 end
68.386 else let val th1 = prove_elementar sg "ss" (HOLogic.mk_binrel "op <" (Const("0",HOLogic.intT),dlcm))
68.387 - in (instantiate' [] [Some cfma, Some cA,Some (cterm_of sg (norm_zero_one z))] (th1 RS (not_ast_p_gt)))
68.388 + in (instantiate' [] [SOME cfma, SOME cA,SOME (cterm_of sg (norm_zero_one z))] (th1 RS (not_ast_p_gt)))
68.389 end
68.390 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
68.391 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
68.392
68.393 |Const ("Not",_) $ (Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.394 if y=x then
68.395 let val cz = cterm_of sg (norm_zero_one z)
68.396 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
68.397 - in (instantiate' [] [Some cfma, Some cA,Some cz] (th1 RS (not_ast_p_ndvd)))
68.398 + in (instantiate' [] [SOME cfma, SOME cA,SOME cz] (th1 RS (not_ast_p_ndvd)))
68.399 end
68.400 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
68.401 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
68.402
68.403 |(Const("Divides.op dvd",_)$ d $ (Const ("op +",_) $ (Const ("op *",_) $ c $ y ) $ z)) =>
68.404 if y=x then
68.405 let val cz = cterm_of sg (norm_zero_one z)
68.406 val th1 = (prove_elementar sg "ss" (HOLogic.mk_binrel "op =" (HOLogic.mk_binop "Divides.op mod" (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
68.407 - in (instantiate' [] [Some cfma,Some cA,Some cz] (th1 RS (not_ast_p_dvd)))
68.408 + in (instantiate' [] [SOME cfma,SOME cA,SOME cz] (th1 RS (not_ast_p_dvd)))
68.409 end
68.410 - else (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
68.411 + else (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
68.412
68.413 - |_ => (instantiate' [] [Some cfma, Some cdlcm, Some cA,Some cat] (not_ast_p_fm))
68.414 + |_ => (instantiate' [] [SOME cfma, SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
68.415
68.416 end;
68.417
68.418 @@ -788,21 +788,21 @@
68.419 fun rho_for_evalc sg at = case at of
68.420 (Const (p,_) $ s $ t) =>(
68.421 case assoc (operations,p) of
68.422 - Some f =>
68.423 + SOME f =>
68.424 ((if (f ((dest_numeral s),(dest_numeral t)))
68.425 then prove_elementar sg "ss" (HOLogic.mk_eq(at,HOLogic.true_const))
68.426 else prove_elementar sg "ss" (HOLogic.mk_eq(at, HOLogic.false_const)))
68.427 - handle _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl)
68.428 - | _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl )
68.429 + handle _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl)
68.430 + | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl )
68.431 |Const("Not",_)$(Const (p,_) $ s $ t) =>(
68.432 case assoc (operations,p) of
68.433 - Some f =>
68.434 + SOME f =>
68.435 ((if (f ((dest_numeral s),(dest_numeral t)))
68.436 then prove_elementar sg "ss" (HOLogic.mk_eq(at, HOLogic.false_const))
68.437 else prove_elementar sg "ss" (HOLogic.mk_eq(at,HOLogic.true_const)))
68.438 - handle _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl)
68.439 - | _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl )
68.440 - | _ => instantiate' [Some cboolT] [Some (cterm_of sg at)] refl;
68.441 + handle _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl)
68.442 + | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl )
68.443 + | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl;
68.444
68.445
68.446 (*=========================================================*)
68.447 @@ -828,7 +828,7 @@
68.448 |(Const("op =", Type ("fun",[Type ("bool", []),_]))$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_eqI)
68.449 |(Const("Not",_)$p) => ([p],fn [th] => th RS qe_Not)
68.450 |(Const("Divides.op dvd",_)$d$r) =>
68.451 - if is_numeral d then ([], fn [] => (prove_elementar sg "lf" (HOLogic.mk_eq (r, lint vars r))) RS (instantiate' [] [None , None, Some (cterm_of sg d)](linearize_dvd)))
68.452 + if is_numeral d then ([], fn [] => (prove_elementar sg "lf" (HOLogic.mk_eq (r, lint vars r))) RS (instantiate' [] [NONE , NONE, SOME (cterm_of sg d)](linearize_dvd)))
68.453 else (warning "Nonlinear Term --- Non numeral leftside at dvd";
68.454 raise COOPER)
68.455 |_ => ([], fn [] => prove_elementar sg "lf" (HOLogic.mk_eq (t, linform vars t)));
68.456 @@ -897,7 +897,7 @@
68.457 val ss = presburger_ss addsimps
68.458 [simp_from_to] delsimps [P_eqtrue, P_eqfalse, bex_triv, insert_iff]
68.459 (* uth : EX x.P(l*x) = EX x. l dvd x & P x*)
68.460 - val uth = instantiate' [] [Some (cterm_of sg P) , Some (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
68.461 + val uth = instantiate' [] [SOME (cterm_of sg P) , SOME (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
68.462 (* e_ac_thm : Ex x. efm = EX x. fm*)
68.463 val e_ac_thm = (forall_intr (cterm_of sg x) ac_thm) COMP (qe_exI)
68.464 (* A and B set of the formula*)
68.465 @@ -961,7 +961,7 @@
68.466 val ss = presburger_ss addsimps
68.467 [simp_from_to] delsimps [P_eqtrue, P_eqfalse, bex_triv, insert_iff]
68.468 (* uth : EX x.P(l*x) = EX x. l dvd x & P x*)
68.469 - val uth = instantiate' [] [Some (cterm_of sg P) , Some (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
68.470 + val uth = instantiate' [] [SOME (cterm_of sg P) , SOME (cterm_of sg (mk_numeral l))] (unity_coeff_ex)
68.471 (* e_ac_thm : Ex x. efm = EX x. fm*)
68.472 val e_ac_thm = (forall_intr (cterm_of sg x) ac_thm) COMP (qe_exI)
68.473 (* lsuth = EX.P(l*x) ; rsuth = EX x. l dvd x & P x*)
68.474 @@ -972,7 +972,7 @@
68.475 val (w,rs) = cooper_w [] cfm
68.476 val exp_cp_thm = case w of
68.477 (* FIXME - e_ac_thm just tipped to test syntactical correctness of the program!!!!*)
68.478 - Some n => e_ac_thm (* Prove cfm (n) and use exI and then Eq_TrueI*)
68.479 + SOME n => e_ac_thm (* Prove cfm (n) and use exI and then Eq_TrueI*)
68.480 |_ => let
68.481 (* A and B set of the formula*)
68.482 val A = aset x cfm
69.1 --- a/src/HOL/Tools/Presburger/presburger.ML Fri Feb 11 18:51:00 2005 +0100
69.2 +++ b/src/HOL/Tools/Presburger/presburger.ML Sun Feb 13 17:15:14 2005 +0100
69.3 @@ -73,7 +73,7 @@
69.4
69.5 fun term_typed_consts t = add_term_typed_consts(t,[]);
69.6
69.7 -(* Some Types*)
69.8 +(* SOME Types*)
69.9 val bT = HOLogic.boolT;
69.10 val iT = HOLogic.intT;
69.11 val binT = HOLogic.binT;
69.12 @@ -246,7 +246,7 @@
69.13 val g' = if a then abstract_pres sg g else g
69.14 (* Transform the term*)
69.15 val (t,np,nh) = prepare_for_presburger sg q g'
69.16 - (* Some simpsets for dealing with mod div abs and nat*)
69.17 + (* SOME simpsets for dealing with mod div abs and nat*)
69.18 val simpset0 = HOL_basic_ss
69.19 addsimps [mod_div_equality', Suc_plus1]
69.20 addsplits [split_zdiv, split_zmod, split_div', split_min, split_max]
69.21 @@ -313,7 +313,7 @@
69.22 "decision procedure for Presburger arithmetic"),
69.23 ArithTheoryData.map (fn {splits, inj_consts, discrete, presburger} =>
69.24 {splits = splits, inj_consts = inj_consts, discrete = discrete,
69.25 - presburger = Some (presburger_tac true false)})];
69.26 + presburger = SOME (presburger_tac true false)})];
69.27
69.28 end;
69.29
70.1 --- a/src/HOL/Tools/Presburger/qelim.ML Fri Feb 11 18:51:00 2005 +0100
70.2 +++ b/src/HOL/Tools/Presburger/qelim.ML Sun Feb 13 17:15:14 2005 +0100
70.3 @@ -51,7 +51,7 @@
70.4 end
70.5
70.6 |(Const("All",_)$Abs(xn,xT,p)) => ([(HOLogic.exists_const xT)$Abs(xn,xT,HOLogic.Not $ p)], fn [th] => th RS qe_ALL)
70.7 - | _ => ([],fn [] => instantiate' [Some (ctyp_of sg (type_of P))] [Some (cterm_of sg P)] refl);
70.8 + | _ => ([],fn [] => instantiate' [SOME (ctyp_of sg (type_of P))] [SOME (cterm_of sg P)] refl);
70.9
70.10
70.11 fun tproof_of_mlift_qelim sg isat afnp nfnp qfnp p =
71.1 --- a/src/HOL/Tools/datatype_aux.ML Fri Feb 11 18:51:00 2005 +0100
71.2 +++ b/src/HOL/Tools/datatype_aux.ML Sun Feb 13 17:15:14 2005 +0100
71.3 @@ -130,11 +130,11 @@
71.4 val ts' = HOLogic.dest_conj (HOLogic.dest_Trueprop
71.5 (Logic.strip_imp_concl (nth_elem (i - 1, prems_of st))));
71.6 val getP = if can HOLogic.dest_imp (hd ts) then
71.7 - (apfst Some) o HOLogic.dest_imp else pair None;
71.8 + (apfst SOME) o HOLogic.dest_imp else pair NONE;
71.9 fun abstr (t1, t2) = (case t1 of
71.10 - None => let val [Free (s, T)] = add_term_frees (t2, [])
71.11 + NONE => let val [Free (s, T)] = add_term_frees (t2, [])
71.12 in absfree (s, T, t2) end
71.13 - | Some (_ $ t' $ _) => Abs ("x", fastype_of t', abstract_over (t', t2)))
71.14 + | SOME (_ $ t' $ _) => Abs ("x", fastype_of t', abstract_over (t', t2)))
71.15 val cert = cterm_of (Thm.sign_of_thm st);
71.16 val Ps = map (cert o head_of o snd o getP) ts;
71.17 val indrule' = cterm_instantiate (Ps ~~
71.18 @@ -197,8 +197,8 @@
71.19
71.20 fun subst_DtTFree _ substs (T as (DtTFree name)) =
71.21 (case assoc (substs, name) of
71.22 - None => T
71.23 - | Some U => U)
71.24 + NONE => T
71.25 + | SOME U => U)
71.26 | subst_DtTFree i substs (DtType (name, ts)) =
71.27 DtType (name, map (subst_DtTFree i substs) ts)
71.28 | subst_DtTFree i _ (DtRec j) = DtRec (i + j);
71.29 @@ -237,8 +237,8 @@
71.30 | dtyp_of_typ _ (TVar _) = error "Illegal schematic type variable(s)"
71.31 | dtyp_of_typ new_dts (Type (tname, Ts)) =
71.32 (case assoc (new_dts, tname) of
71.33 - None => DtType (tname, map (dtyp_of_typ new_dts) Ts)
71.34 - | Some vs => if map (try dest_TFree) Ts = map Some vs then
71.35 + NONE => DtType (tname, map (dtyp_of_typ new_dts) Ts)
71.36 + | SOME vs => if map (try dest_TFree) Ts = map SOME vs then
71.37 DtRec (find_index (curry op = tname o fst) new_dts)
71.38 else error ("Illegal occurence of recursive type " ^ tname));
71.39
71.40 @@ -300,9 +300,9 @@
71.41
71.42 fun get_dt_descr T i tname dts =
71.43 (case Symtab.lookup (dt_info, tname) of
71.44 - None => typ_error T (tname ^ " is not a datatype - can't use it in\
71.45 + NONE => typ_error T (tname ^ " is not a datatype - can't use it in\
71.46 \ nested recursion")
71.47 - | (Some {index, descr, ...}) =>
71.48 + | (SOME {index, descr, ...}) =>
71.49 let val (_, vars, _) = the (assoc (descr, index));
71.50 val subst = ((map dest_DtTFree vars) ~~ dts) handle LIST _ =>
71.51 typ_error T ("Type constructor " ^ tname ^ " used with wrong\
72.1 --- a/src/HOL/Tools/datatype_codegen.ML Fri Feb 11 18:51:00 2005 +0100
72.2 +++ b/src/HOL/Tools/datatype_codegen.ML Sun Feb 13 17:15:14 2005 +0100
72.3 @@ -27,17 +27,17 @@
72.4 fun find_nonempty (descr: DatatypeAux.descr) is i =
72.5 let
72.6 val (_, _, constrs) = the (assoc (descr, i));
72.7 - fun arg_nonempty (_, DatatypeAux.DtRec i) = if i mem is then None
72.8 + fun arg_nonempty (_, DatatypeAux.DtRec i) = if i mem is then NONE
72.9 else apsome (curry op + 1 o snd) (find_nonempty descr (i::is) i)
72.10 - | arg_nonempty _ = Some 0;
72.11 + | arg_nonempty _ = SOME 0;
72.12 fun max xs = foldl
72.13 - (fn (None, _) => None
72.14 - | (Some i, Some j) => Some (Int.max (i, j))
72.15 - | (_, None) => None) (Some 0, xs);
72.16 + (fn (NONE, _) => NONE
72.17 + | (SOME i, SOME j) => SOME (Int.max (i, j))
72.18 + | (_, NONE) => NONE) (SOME 0, xs);
72.19 val xs = sort (int_ord o pairself snd)
72.20 (mapfilter (fn (s, dts) => apsome (pair s)
72.21 (max (map (arg_nonempty o DatatypeAux.strip_dtyp) dts))) constrs)
72.22 - in case xs of [] => None | x :: _ => Some x end;
72.23 + in case xs of [] => NONE | x :: _ => SOME x end;
72.24
72.25 fun add_dt_defs thy dep gr (descr: DatatypeAux.descr) =
72.26 let
72.27 @@ -109,7 +109,7 @@
72.28 val sorts = map (rpair []) tvs;
72.29 val (cs1, cs2) =
72.30 partition (exists DatatypeAux.is_rec_type o snd) cs;
72.31 - val Some (cname, _) = find_nonempty descr [i] i;
72.32 + val SOME (cname, _) = find_nonempty descr [i] i;
72.33
72.34 fun mk_delay p = Pretty.block
72.35 [Pretty.str "fn () =>", Pretty.brk 1, p];
72.36 @@ -173,10 +173,10 @@
72.37 handle Graph.CYCLES _ => gr) handle Graph.UNDEF _ =>
72.38 let
72.39 val gr1 = Graph.add_edge (dname, dep)
72.40 - (Graph.new_node (dname, (None, "")) gr);
72.41 + (Graph.new_node (dname, (NONE, "")) gr);
72.42 val (gr2, dtdef) = mk_dtdef gr1 "datatype " descr';
72.43 in
72.44 - Graph.map_node dname (K (None,
72.45 + Graph.map_node dname (K (NONE,
72.46 Pretty.string_of (Pretty.blk (0, separate Pretty.fbrk dtdef @
72.47 [Pretty.str ";"])) ^ "\n\n" ^
72.48 (if "term_of" mem !mode then
72.49 @@ -259,33 +259,33 @@
72.50 s = case_name orelse
72.51 is_some (assoc (#3 (the (assoc (descr, index))), s)))
72.52 (Symtab.dest (DatatypePackage.get_datatypes thy)) of
72.53 - None => None
72.54 - | Some (tname, {index, descr, ...}) =>
72.55 - if is_some (get_assoc_code thy s T) then None else
72.56 - let val Some (_, _, constrs) = assoc (descr, index)
72.57 + NONE => NONE
72.58 + | SOME (tname, {index, descr, ...}) =>
72.59 + if is_some (get_assoc_code thy s T) then NONE else
72.60 + let val SOME (_, _, constrs) = assoc (descr, index)
72.61 in (case (assoc (constrs, s), strip_type T) of
72.62 - (None, _) => Some (pretty_case thy gr dep brack
72.63 + (NONE, _) => SOME (pretty_case thy gr dep brack
72.64 (#3 (the (assoc (descr, index)))) c ts)
72.65 - | (Some args, (_, Type _)) => Some (pretty_constr thy
72.66 + | (SOME args, (_, Type _)) => SOME (pretty_constr thy
72.67 (fst (invoke_tycodegen thy dep false (gr, snd (strip_type T))))
72.68 dep brack args c ts)
72.69 - | _ => None)
72.70 + | _ => NONE)
72.71 end)
72.72 - | _ => None);
72.73 + | _ => NONE);
72.74
72.75 fun datatype_tycodegen thy gr dep brack (Type (s, Ts)) =
72.76 (case Symtab.lookup (DatatypePackage.get_datatypes thy, s) of
72.77 - None => None
72.78 - | Some {descr, ...} =>
72.79 - if is_some (get_assoc_type thy s) then None else
72.80 + NONE => NONE
72.81 + | SOME {descr, ...} =>
72.82 + if is_some (get_assoc_type thy s) then NONE else
72.83 let val (gr', ps) = foldl_map
72.84 (invoke_tycodegen thy dep false) (gr, Ts)
72.85 - in Some (add_dt_defs thy dep gr' descr,
72.86 + in SOME (add_dt_defs thy dep gr' descr,
72.87 Pretty.block ((if null Ts then [] else
72.88 [mk_tuple ps, Pretty.str " "]) @
72.89 [Pretty.str (mk_type_id (sign_of thy) s)]))
72.90 end)
72.91 - | datatype_tycodegen _ _ _ _ _ = None;
72.92 + | datatype_tycodegen _ _ _ _ _ = NONE;
72.93
72.94
72.95 val setup =
73.1 --- a/src/HOL/Tools/datatype_package.ML Fri Feb 11 18:51:00 2005 +0100
73.2 +++ b/src/HOL/Tools/datatype_package.ML Sun Feb 13 17:15:14 2005 +0100
73.3 @@ -114,28 +114,28 @@
73.4 fun datatype_info_sg sg name = Symtab.lookup (get_datatypes_sg sg, name);
73.5
73.6 fun datatype_info_sg_err sg name = (case datatype_info_sg sg name of
73.7 - Some info => info
73.8 - | None => error ("Unknown datatype " ^ quote name));
73.9 + SOME info => info
73.10 + | NONE => error ("Unknown datatype " ^ quote name));
73.11
73.12 val datatype_info = datatype_info_sg o Theory.sign_of;
73.13
73.14 fun datatype_info_err thy name = (case datatype_info thy name of
73.15 - Some info => info
73.16 - | None => error ("Unknown datatype " ^ quote name));
73.17 + SOME info => info
73.18 + | NONE => error ("Unknown datatype " ^ quote name));
73.19
73.20 fun constrs_of_sg sg tname = (case datatype_info_sg sg tname of
73.21 - Some {index, descr, ...} =>
73.22 + SOME {index, descr, ...} =>
73.23 let val (_, _, constrs) = the (assoc (descr, index))
73.24 - in Some (map (fn (cname, _) => Const (cname, the (Sign.const_type sg cname))) constrs)
73.25 + in SOME (map (fn (cname, _) => Const (cname, the (Sign.const_type sg cname))) constrs)
73.26 end
73.27 - | _ => None);
73.28 + | _ => NONE);
73.29
73.30 val constrs_of = constrs_of_sg o Theory.sign_of;
73.31
73.32 fun case_const_of thy tname = (case datatype_info thy tname of
73.33 - Some {case_name, ...} => Some (Const (case_name, the (Sign.const_type
73.34 + SOME {case_name, ...} => SOME (Const (case_name, the (Sign.const_type
73.35 (Theory.sign_of thy) case_name)))
73.36 - | _ => None);
73.37 + | _ => NONE);
73.38
73.39 val weak_case_congs_of_sg = map (#weak_case_cong o #2) o Symtab.dest o get_datatypes_sg;
73.40 val weak_case_congs_of = weak_case_congs_of_sg o Theory.sign_of;
73.41 @@ -144,8 +144,8 @@
73.42 let val frees = map dest_Free (term_frees Bi)
73.43 val params = rename_wrt_term Bi (Logic.strip_params Bi);
73.44 in case assoc (frees @ params, var) of
73.45 - None => error ("No such variable in subgoal: " ^ quote var)
73.46 - | Some(Type (tn, _)) => tn
73.47 + NONE => error ("No such variable in subgoal: " ^ quote var)
73.48 + | SOME(Type (tn, _)) => tn
73.49 | _ => error ("Cannot determine type of " ^ quote var)
73.50 end;
73.51
73.52 @@ -156,7 +156,7 @@
73.53 val params = Logic.strip_params Bi; (*params of subgoal i*)
73.54 val params = rev (rename_wrt_term Bi params); (*as they are printed*)
73.55 val (types, sorts) = types_sorts state;
73.56 - fun types' (a, ~1) = (case assoc (params, a) of None => types(a, ~1) | sm => sm)
73.57 + fun types' (a, ~1) = (case assoc (params, a) of NONE => types(a, ~1) | sm => sm)
73.58 | types' ixn = types ixn;
73.59 val (ct, _) = read_def_cterm (sign, types', sorts) [] false (aterm, TypeInfer.logicT);
73.60 in case #T (rep_cterm ct) of
73.61 @@ -179,8 +179,8 @@
73.62
73.63 local
73.64
73.65 -fun prep_var (Var (ixn, _), Some x) = Some (ixn, x)
73.66 - | prep_var _ = None;
73.67 +fun prep_var (Var (ixn, _), SOME x) = SOME (ixn, x)
73.68 + | prep_var _ = NONE;
73.69
73.70 fun prep_inst (concl, xs) = (*exception LIST*)
73.71 let val vs = InductAttrib.vars_of concl
73.72 @@ -194,8 +194,8 @@
73.73 val {sign, ...} = Thm.rep_thm state;
73.74 val (rule, rule_name) =
73.75 (case opt_rule of
73.76 - Some r => (r, "Induction rule")
73.77 - | None =>
73.78 + SOME r => (r, "Induction rule")
73.79 + | NONE =>
73.80 let val tn = find_tname (hd (mapfilter I (flat varss))) Bi
73.81 in (#induction (datatype_info_sg_err sign tn), "Induction rule for type " ^ tn) end);
73.82
73.83 @@ -206,11 +206,11 @@
73.84
73.85 fun induct_tac s =
73.86 gen_induct_tac Tactic.res_inst_tac'
73.87 - (map (Library.single o Some) (Syntax.read_idents s), None);
73.88 + (map (Library.single o SOME) (Syntax.read_idents s), NONE);
73.89
73.90 fun induct_thm_tac th s =
73.91 gen_induct_tac Tactic.res_inst_tac'
73.92 - ([map Some (Syntax.read_idents s)], Some th);
73.93 + ([map SOME (Syntax.read_idents s)], SOME th);
73.94
73.95 end;
73.96
73.97 @@ -223,9 +223,9 @@
73.98 (hd (Logic.strip_assums_hyp (hd (Thm.prems_of rule))));
73.99 in inst_tac [(ixn, t)] rule i state end;
73.100
73.101 -fun gen_case_tac inst_tac (t, Some rule) i state =
73.102 +fun gen_case_tac inst_tac (t, SOME rule) i state =
73.103 case_inst_tac inst_tac t rule i state
73.104 - | gen_case_tac inst_tac (t, None) i state =
73.105 + | gen_case_tac inst_tac (t, NONE) i state =
73.106 let val tn = infer_tname state i t in
73.107 if tn = HOLogic.boolN then inst_tac [(("P", 0), t)] case_split_thm i state
73.108 else case_inst_tac inst_tac t
73.109 @@ -233,7 +233,7 @@
73.110 i state
73.111 end handle THM _ => Seq.empty;
73.112
73.113 -fun case_tac t = gen_case_tac Tactic.res_inst_tac' (t, None);
73.114 +fun case_tac t = gen_case_tac Tactic.res_inst_tac' (t, NONE);
73.115
73.116
73.117
73.118 @@ -349,34 +349,34 @@
73.119 ((i', Type (tname1, _)), (j', Type (tname2, _))) =>
73.120 if tname1 = tname2 andalso not (cname1 = cname2) andalso i = i' andalso j = j' then
73.121 (case (constrs_of_sg sg tname1) of
73.122 - Some constrs => let val cnames = map (fst o dest_Const) constrs
73.123 + SOME constrs => let val cnames = map (fst o dest_Const) constrs
73.124 in if cname1 mem cnames andalso cname2 mem cnames then
73.125 let val eq_t = Logic.mk_equals (t, Const ("False", HOLogic.boolT));
73.126 val eq_ct = cterm_of sg eq_t;
73.127 val Datatype_thy = theory "Datatype";
73.128 val [In0_inject, In1_inject, In0_not_In1, In1_not_In0] =
73.129 - map (get_thm Datatype_thy o rpair None)
73.130 + map (get_thm Datatype_thy o rpair NONE)
73.131 ["In0_inject", "In1_inject", "In0_not_In1", "In1_not_In0"]
73.132 in (case (#distinct (datatype_info_sg_err sg tname1)) of
73.133 - QuickAndDirty => Some (Thm.invoke_oracle
73.134 + QuickAndDirty => SOME (Thm.invoke_oracle
73.135 Datatype_thy distinctN (sg, ConstrDistinct eq_t))
73.136 - | FewConstrs thms => Some (Tactic.prove sg [] [] eq_t (K
73.137 + | FewConstrs thms => SOME (Tactic.prove sg [] [] eq_t (K
73.138 (EVERY [rtac eq_reflection 1, rtac iffI 1, rtac notE 1,
73.139 atac 2, resolve_tac thms 1, etac FalseE 1])))
73.140 - | ManyConstrs (thm, ss) => Some (Tactic.prove sg [] [] eq_t (K
73.141 + | ManyConstrs (thm, ss) => SOME (Tactic.prove sg [] [] eq_t (K
73.142 (EVERY [rtac eq_reflection 1, rtac iffI 1, dtac thm 1,
73.143 full_simp_tac ss 1,
73.144 REPEAT (dresolve_tac [In0_inject, In1_inject] 1),
73.145 eresolve_tac [In0_not_In1 RS notE, In1_not_In0 RS notE] 1,
73.146 etac FalseE 1]))))
73.147 end
73.148 - else None
73.149 + else NONE
73.150 end
73.151 - | None => None)
73.152 - else None
73.153 - | _ => None)
73.154 - | _ => None)
73.155 - | distinct_proc sg _ _ = None;
73.156 + | NONE => NONE)
73.157 + else NONE
73.158 + | _ => NONE)
73.159 + | _ => NONE)
73.160 + | distinct_proc sg _ _ = NONE;
73.161
73.162 val distinct_simproc =
73.163 Simplifier.simproc (Theory.sign_of HOL.thy) distinctN ["s = t"] distinct_proc;
73.164 @@ -397,52 +397,52 @@
73.165 fun dest_case1 (Const ("_case1", _) $ t $ u) = (case strip_comb t of
73.166 (Const (s, _), ts) => (Sign.intern_const sg s, ts)
73.167 | (Free (s, _), ts) => (Sign.intern_const sg s, ts)
73.168 - | _ => case_error "Head is not a constructor" None [t, u], u)
73.169 + | _ => case_error "Head is not a constructor" NONE [t, u], u)
73.170 | dest_case1 t = raise TERM ("dest_case1", [t]);
73.171 fun dest_case2 (Const ("_case2", _) $ t $ u) = t :: dest_case2 u
73.172 | dest_case2 t = [t];
73.173 val cases as ((cname, _), _) :: _ = map dest_case1 (dest_case2 u);
73.174 val tab = Symtab.dest (get_datatypes_sg sg);
73.175 val (cases', default) = (case split_last cases of
73.176 - (cases', (("dummy_pattern", []), t)) => (cases', Some t)
73.177 - | _ => (cases, None))
73.178 + (cases', (("dummy_pattern", []), t)) => (cases', SOME t)
73.179 + | _ => (cases, NONE))
73.180 fun abstr (Free (x, T), body) = Term.absfree (x, T, body)
73.181 | abstr (Const ("_constrain", _) $ Free (x, T) $ tT, body) =
73.182 Syntax.const Syntax.constrainAbsC $ Term.absfree (x, T, body) $ tT
73.183 | abstr (Const ("Pair", _) $ x $ y, body) =
73.184 Syntax.const "split" $ abstr (x, abstr (y, body))
73.185 - | abstr (t, _) = case_error "Illegal pattern" None [t];
73.186 + | abstr (t, _) = case_error "Illegal pattern" NONE [t];
73.187 in case find_first (fn (_, {descr, index, ...}) =>
73.188 exists (equal cname o fst) (#3 (snd (nth_elem (index, descr))))) tab of
73.189 - None => case_error ("Not a datatype constructor: " ^ cname) None [u]
73.190 - | Some (tname, {descr, case_name, index, ...}) =>
73.191 + NONE => case_error ("Not a datatype constructor: " ^ cname) NONE [u]
73.192 + | SOME (tname, {descr, case_name, index, ...}) =>
73.193 let
73.194 val _ = if exists (equal "dummy_pattern" o fst o fst) cases' then
73.195 - case_error "Illegal occurrence of '_' dummy pattern" (Some tname) [u] else ();
73.196 + case_error "Illegal occurrence of '_' dummy pattern" (SOME tname) [u] else ();
73.197 val (_, (_, dts, constrs)) = nth_elem (index, descr);
73.198 val sorts = map (rpair [] o dest_DtTFree) dts;
73.199 fun find_case (cases, (s, dt)) =
73.200 (case find_first (equal s o fst o fst) cases' of
73.201 - None => (case default of
73.202 - None => case_error ("No clause for constructor " ^ s) (Some tname) [u]
73.203 - | Some t => (cases, list_abs (map (rpair dummyT) (DatatypeProp.make_tnames
73.204 + NONE => (case default of
73.205 + NONE => case_error ("No clause for constructor " ^ s) (SOME tname) [u]
73.206 + | SOME t => (cases, list_abs (map (rpair dummyT) (DatatypeProp.make_tnames
73.207 (map (typ_of_dtyp descr sorts) dt)), t)))
73.208 - | Some (c as ((_, vs), t)) =>
73.209 + | SOME (c as ((_, vs), t)) =>
73.210 if length dt <> length vs then
73.211 case_error ("Wrong number of arguments for constructor " ^ s)
73.212 - (Some tname) vs
73.213 + (SOME tname) vs
73.214 else (cases \ c, foldr abstr (vs, t)))
73.215 val (cases'', fs) = foldl_map find_case (cases', constrs)
73.216 in case (cases'', length constrs = length cases', default) of
73.217 - ([], true, Some _) =>
73.218 - case_error "Extra '_' dummy pattern" (Some tname) [u]
73.219 + ([], true, SOME _) =>
73.220 + case_error "Extra '_' dummy pattern" (SOME tname) [u]
73.221 | (_ :: _, _, _) =>
73.222 let val extra = distinct (map (fst o fst) cases'')
73.223 in case extra \\ map fst constrs of
73.224 [] => case_error ("More than one clause for constructor(s) " ^
73.225 - commas extra) (Some tname) [u]
73.226 + commas extra) (SOME tname) [u]
73.227 | extra' => case_error ("Illegal constructor(s): " ^ commas extra')
73.228 - (Some tname) [u]
73.229 + (SOME tname) [u]
73.230 end
73.231 | _ => list_comb (Syntax.const case_name, fs) $ t
73.232 end
73.233 @@ -470,8 +470,8 @@
73.234 (constrs ~~ fs);
73.235 fun count_cases (cs, (_, _, true)) = cs
73.236 | count_cases (cs, (cname, (_, body), false)) = (case assoc (cs, body) of
73.237 - None => (body, [cname]) :: cs
73.238 - | Some cnames => overwrite (cs, (body, cnames @ [cname])));
73.239 + NONE => (body, [cname]) :: cs
73.240 + | SOME cnames => overwrite (cs, (body, cnames @ [cname])));
73.241 val cases' = sort (int_ord o Library.swap o pairself (length o snd))
73.242 (foldl count_cases ([], cases));
73.243 fun mk_case1 (cname, (vs, body), _) = Syntax.const "_case1" $
73.244 @@ -660,7 +660,7 @@
73.245 Theory.parent_path |>>>
73.246 add_and_get_axiomss "inject" new_type_names
73.247 (DatatypeProp.make_injs descr sorts);
73.248 - val size_thms = if no_size then [] else get_thms thy3 ("size", None);
73.249 + val size_thms = if no_size then [] else get_thms thy3 ("size", NONE);
73.250 val (thy4, distinct) = add_and_get_axiomss "distinct" new_type_names
73.251 (DatatypeProp.make_distincts new_type_names descr sorts thy3) thy3;
73.252
73.253 @@ -945,7 +945,7 @@
73.254 val dt_info = get_datatypes thy;
73.255 val (descr, _) = unfold_datatypes sign dts' sorts dt_info dts' i;
73.256 val _ = check_nonempty descr handle (exn as Datatype_Empty s) =>
73.257 - if err then error ("Nonemptiness check failed for datatype " ^ s)
73.258 + if err then error ("NONEmptiness check failed for datatype " ^ s)
73.259 else raise exn;
73.260
73.261 val descr' = flat descr;
73.262 @@ -978,7 +978,7 @@
73.263
73.264 fun mk_datatype args =
73.265 let
73.266 - val names = map (fn ((((None, _), t), _), _) => t | ((((Some t, _), _), _), _) => t) args;
73.267 + val names = map (fn ((((NONE, _), t), _), _) => t | ((((SOME t, _), _), _), _) => t) args;
73.268 val specs = map (fn ((((_, vs), t), mx), cons) =>
73.269 (vs, t, mx, map (fn ((x, y), z) => (x, y, z)) cons)) args;
73.270 in #1 o add_datatype false names specs end;
74.1 --- a/src/HOL/Tools/datatype_prop.ML Fri Feb 11 18:51:00 2005 +0100
74.2 +++ b/src/HOL/Tools/datatype_prop.ML Sun Feb 13 17:15:14 2005 +0100
74.3 @@ -45,8 +45,8 @@
74.4 let
74.5 fun index (x :: xs) tab =
74.6 (case assoc (tab, x) of
74.7 - None => if x mem xs then (x ^ "1") :: index xs ((x, 2) :: tab) else x :: index xs tab
74.8 - | Some i => (x ^ Library.string_of_int i) :: index xs ((x, i + 1) :: tab))
74.9 + NONE => if x mem xs then (x ^ "1") :: index xs ((x, 2) :: tab) else x :: index xs tab
74.10 + | SOME i => (x ^ Library.string_of_int i) :: index xs ((x, i + 1) :: tab))
74.11 | index [] _ = [];
74.12 in index names [] end;
74.13
75.1 --- a/src/HOL/Tools/datatype_realizer.ML Fri Feb 11 18:51:00 2005 +0100
75.2 +++ b/src/HOL/Tools/datatype_realizer.ML Sun Feb 13 17:15:14 2005 +0100
75.3 @@ -24,7 +24,7 @@
75.4
75.5 fun forall_intr_prf (t, prf) =
75.6 let val (a, T) = (case t of Var ((a, _), T) => (a, T) | Free p => p)
75.7 - in Abst (a, Some T, Proofterm.prf_abstract_over t prf) end;
75.8 + in Abst (a, SOME T, Proofterm.prf_abstract_over t prf) end;
75.9
75.10 fun prf_of thm =
75.11 let val {sign, prop, der = (_, prf), ...} = rep_thm thm
75.12 @@ -108,9 +108,9 @@
75.13 (descr ~~ recTs ~~ rec_result_Ts ~~ rec_names);
75.14 val r = if null is then Extraction.nullt else
75.15 foldr1 HOLogic.mk_prod (mapfilter (fn (((((i, _), T), U), s), tname) =>
75.16 - if i mem is then Some
75.17 + if i mem is then SOME
75.18 (list_comb (Const (s, fTs ---> T --> U), rec_fns) $ Free (tname, T))
75.19 - else None) (descr ~~ recTs ~~ rec_result_Ts ~~ rec_names ~~ tnames));
75.20 + else NONE) (descr ~~ recTs ~~ rec_result_Ts ~~ rec_names ~~ tnames));
75.21 val concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop "op &")
75.22 (map (fn ((((i, _), T), U), tname) =>
75.23 make_pred i U T (mk_proj i is r) (Free (tname, T)))
75.24 @@ -149,10 +149,10 @@
75.25 (case head_of (strip_abs_body f) of
75.26 Free (s, T) =>
75.27 let val T' = Type.varifyT T
75.28 - in Abst (s, Some T', Proofterm.prf_abstract_over
75.29 - (Var ((s, 0), T')) (AbsP ("H", Some p, prf)))
75.30 + in Abst (s, SOME T', Proofterm.prf_abstract_over
75.31 + (Var ((s, 0), T')) (AbsP ("H", SOME p, prf)))
75.32 end
75.33 - | _ => AbsP ("H", Some p, prf)))
75.34 + | _ => AbsP ("H", SOME p, prf)))
75.35 (rec_fns ~~ prems_of thm, Proofterm.proof_combP
75.36 (prf_of thm', map PBound (length prems - 1 downto 0))));
75.37
75.38 @@ -183,7 +183,7 @@
75.39 list_comb (r, free_ts)))))
75.40 end;
75.41
75.42 - val Some (_, _, constrs) = assoc (descr, index);
75.43 + val SOME (_, _, constrs) = assoc (descr, index);
75.44 val T = nth_elem (index, get_rec_types descr sorts);
75.45 val (rs, prems) = split_list (map (make_casedist_prem T) constrs);
75.46 val r = Const (case_name, map fastype_of rs ---> T --> rT);
75.47 @@ -210,7 +210,7 @@
75.48 val P = Var (("P", 0), rT' --> HOLogic.boolT);
75.49 val prf = forall_intr_prf (y, forall_intr_prf (P,
75.50 foldr (fn ((p, r), prf) =>
75.51 - forall_intr_prf (Logic.varify r, AbsP ("H", Some (Logic.varify p),
75.52 + forall_intr_prf (Logic.varify r, AbsP ("H", SOME (Logic.varify p),
75.53 prf))) (prems ~~ rs, Proofterm.proof_combP (prf_of thm',
75.54 map PBound (length prems - 1 downto 0)))));
75.55 val r' = Logic.varify (Abs ("y", Type.varifyT T,
76.1 --- a/src/HOL/Tools/datatype_rep_proofs.ML Fri Feb 11 18:51:00 2005 +0100
76.2 +++ b/src/HOL/Tools/datatype_rep_proofs.ML Sun Feb 13 17:15:14 2005 +0100
76.3 @@ -57,7 +57,7 @@
76.4
76.5 val [In0_inject, In1_inject, Scons_inject, Leaf_inject,
76.6 In0_eq, In1_eq, In0_not_In1, In1_not_In0,
76.7 - Lim_inject, Suml_inject, Sumr_inject] = map (get_thm Datatype_thy o rpair None)
76.8 + Lim_inject, Suml_inject, Sumr_inject] = map (get_thm Datatype_thy o rpair NONE)
76.9 ["In0_inject", "In1_inject", "Scons_inject", "Leaf_inject",
76.10 "In0_eq", "In1_eq", "In0_not_In1", "In1_not_In0",
76.11 "Lim_inject", "Suml_inject", "Sumr_inject"];
76.12 @@ -181,7 +181,7 @@
76.13
76.14 val thy3 = add_path flat_names big_name (foldl (fn (thy, ((((name, mx), tvs), c), name')) =>
76.15 setmp TypedefPackage.quiet_mode true
76.16 - (TypedefPackage.add_typedef_i false (Some name') (name, tvs, mx) c None
76.17 + (TypedefPackage.add_typedef_i false (SOME name') (name, tvs, mx) c NONE
76.18 (rtac exI 1 THEN
76.19 QUIET_BREADTH_FIRST (has_fewer_prems 1)
76.20 (resolve_tac rep_intrs 1))) thy |> #1)
76.21 @@ -261,9 +261,9 @@
76.22 (* get axioms from theory *)
76.23
76.24 val newT_iso_axms = map (fn s =>
76.25 - (get_thm thy4 ("Abs_" ^ s ^ "_inverse", None),
76.26 - get_thm thy4 ("Rep_" ^ s ^ "_inverse", None),
76.27 - get_thm thy4 ("Rep_" ^ s, None))) new_type_names;
76.28 + (get_thm thy4 ("Abs_" ^ s ^ "_inverse", NONE),
76.29 + get_thm thy4 ("Rep_" ^ s ^ "_inverse", NONE),
76.30 + get_thm thy4 ("Rep_" ^ s, NONE))) new_type_names;
76.31
76.32 (*------------------------------------------------*)
76.33 (* prove additional theorems: *)
77.1 --- a/src/HOL/Tools/inductive_codegen.ML Fri Feb 11 18:51:00 2005 +0100
77.2 +++ b/src/HOL/Tools/inductive_codegen.ML Sun Feb 13 17:15:14 2005 +0100
77.3 @@ -70,13 +70,13 @@
77.4 fun get_clauses thy s =
77.5 let val {intros, graph, ...} = CodegenData.get thy
77.6 in case Symtab.lookup (intros, s) of
77.7 - None => (case InductivePackage.get_inductive thy s of
77.8 - None => None
77.9 - | Some ({names, ...}, {intrs, ...}) => Some (names, preprocess thy intrs))
77.10 - | Some _ =>
77.11 - let val Some names = find_first
77.12 + NONE => (case InductivePackage.get_inductive thy s of
77.13 + NONE => NONE
77.14 + | SOME ({names, ...}, {intrs, ...}) => SOME (names, preprocess thy intrs))
77.15 + | SOME _ =>
77.16 + let val SOME names = find_first
77.17 (fn xs => s mem xs) (Graph.strong_conn graph)
77.18 - in Some (names, preprocess thy
77.19 + in SOME (names, preprocess thy
77.20 (flat (map (fn s => the (Symtab.lookup (intros, s))) names)))
77.21 end
77.22 end;
77.23 @@ -115,17 +115,17 @@
77.24 fun infer_factors sg extra_fs (fs, (optf, t)) =
77.25 let fun err s = error (s ^ "\n" ^ Sign.string_of_term sg t)
77.26 in (case (optf, strip_comb t) of
77.27 - (Some f, (Const (name, _), args)) =>
77.28 + (SOME f, (Const (name, _), args)) =>
77.29 (case assoc (extra_fs, name) of
77.30 - None => overwrite (fs, (name, if_none
77.31 + NONE => overwrite (fs, (name, if_none
77.32 (apsome (mg_factor f) (assoc (fs, name))) f))
77.33 - | Some (fs', f') => (mg_factor f (FFix f');
77.34 + | SOME (fs', f') => (mg_factor f (FFix f');
77.35 foldl (infer_factors sg extra_fs)
77.36 (fs, map (apsome FFix) fs' ~~ args)))
77.37 - | (Some f, (Var ((name, _), _), [])) =>
77.38 + | (SOME f, (Var ((name, _), _), [])) =>
77.39 overwrite (fs, (name, if_none
77.40 (apsome (mg_factor f) (assoc (fs, name))) f))
77.41 - | (None, _) => fs
77.42 + | (NONE, _) => fs
77.43 | _ => err "Illegal term")
77.44 handle Factors => err "Product factor mismatch in"
77.45 end;
77.46 @@ -145,8 +145,8 @@
77.47 fun check t = (case strip_comb t of
77.48 (Var _, []) => true
77.49 | (Const (s, _), ts) => (case assoc (cnstrs, s) of
77.50 - None => false
77.51 - | Some i => length ts = i andalso forall check ts)
77.52 + NONE => false
77.53 + | SOME i => length ts = i andalso forall check ts)
77.54 | _ => false)
77.55 in check end;
77.56
77.57 @@ -158,9 +158,9 @@
77.58 (**** mode inference ****)
77.59
77.60 fun string_of_mode (iss, is) = space_implode " -> " (map
77.61 - (fn None => "X"
77.62 - | Some js => enclose "[" "]" (commas (map string_of_int js)))
77.63 - (iss @ [Some is]));
77.64 + (fn NONE => "X"
77.65 + | SOME js => enclose "[" "]" (commas (map string_of_int js)))
77.66 + (iss @ [SOME is]));
77.67
77.68 fun print_modes modes = message ("Inferred modes:\n" ^
77.69 space_implode "\n" (map (fn (s, ms) => s ^ ": " ^ commas (map
77.70 @@ -198,8 +198,8 @@
77.71 let
77.72 fun mk_modes name args = flat
77.73 (map (fn (m as (iss, is)) => map (Mode o pair m) (cprods (map
77.74 - (fn (None, _) => [None]
77.75 - | (Some js, arg) => map Some
77.76 + (fn (NONE, _) => [NONE]
77.77 + | (SOME js, arg) => map SOME
77.78 (filter (fn Mode ((_, js'), _) => js=js') (modes_of modes arg)))
77.79 (iss ~~ args)))) (the (assoc (modes, name))))
77.80
77.81 @@ -230,18 +230,18 @@
77.82 forall is_eqT dupTs
77.83 end)
77.84 (modes_of modes t handle OPTION => [Mode (([], []), [])])
77.85 - | Sidecond t => if term_vs t subset vs then Some (Mode (([], []), []))
77.86 - else None) ps);
77.87 + | Sidecond t => if term_vs t subset vs then SOME (Mode (([], []), []))
77.88 + else NONE) ps);
77.89
77.90 fun check_mode_clause thy arg_vs modes (iss, is) (ts, ps) =
77.91 let
77.92 val modes' = modes @ mapfilter
77.93 - (fn (_, None) => None | (v, Some js) => Some (v, [([], js)]))
77.94 + (fn (_, NONE) => NONE | (v, SOME js) => SOME (v, [([], js)]))
77.95 (arg_vs ~~ iss);
77.96 - fun check_mode_prems vs [] = Some vs
77.97 + fun check_mode_prems vs [] = SOME vs
77.98 | check_mode_prems vs ps = (case select_mode_prem thy modes' vs ps of
77.99 - None => None
77.100 - | Some (x, _) => check_mode_prems
77.101 + NONE => NONE
77.102 + | SOME (x, _) => check_mode_prems
77.103 (case x of Prem (us, _) => vs union terms_vs us | _ => vs)
77.104 (filter_out (equal x) ps));
77.105 val (in_ts, in_ts') = partition (is_constrt thy) (fst (get_args is 1 ts));
77.106 @@ -251,12 +251,12 @@
77.107 forall is_eqT (map snd (duplicates (flat (map term_vTs in_ts)))) andalso
77.108 forall (is_eqT o fastype_of) in_ts' andalso
77.109 (case check_mode_prems (arg_vs union in_vs) ps of
77.110 - None => false
77.111 - | Some vs => concl_vs subset vs)
77.112 + NONE => false
77.113 + | SOME vs => concl_vs subset vs)
77.114 end;
77.115
77.116 fun check_modes_pred thy arg_vs preds modes (p, ms) =
77.117 - let val Some rs = assoc (preds, p)
77.118 + let val SOME rs = assoc (preds, p)
77.119 in (p, filter (fn m => case find_index
77.120 (not o check_mode_clause thy arg_vs modes m) rs of
77.121 ~1 => true
77.122 @@ -271,8 +271,8 @@
77.123 fun infer_modes thy extra_modes factors arg_vs preds = fixp (fn modes =>
77.124 map (check_modes_pred thy arg_vs preds (modes @ extra_modes)) modes)
77.125 (map (fn (s, (fs, f)) => (s, cprod (cprods (map
77.126 - (fn None => [None]
77.127 - | Some f' => map Some (subsets 1 (length f' + 1))) fs),
77.128 + (fn NONE => [NONE]
77.129 + | SOME f' => map SOME (subsets 1 (length f' + 1))) fs),
77.130 subsets 1 (length f + 1)))) factors);
77.131
77.132 (**** code generation ****)
77.133 @@ -332,8 +332,8 @@
77.134 end;
77.135
77.136 fun mk_v ((names, vs), s) = (case assoc (vs, s) of
77.137 - None => ((names, (s, [s])::vs), s)
77.138 - | Some xs => let val s' = variant names s in
77.139 + NONE => ((names, (s, [s])::vs), s)
77.140 + | SOME xs => let val s' = variant names s in
77.141 ((s'::names, overwrite (vs, (s, s'::xs))), s') end);
77.142
77.143 fun distinct_v (nvs, Var ((s, 0), T)) =
77.144 @@ -369,11 +369,11 @@
77.145 (mk_const_id (sign_of thy) s ::
77.146 map (space_implode "_" o map string_of_int) (mapfilter I iss @ [is]));
77.147
77.148 -fun compile_expr thy dep brack (gr, (None, t)) =
77.149 +fun compile_expr thy dep brack (gr, (NONE, t)) =
77.150 apsnd single (invoke_codegen thy dep brack (gr, t))
77.151 - | compile_expr _ _ _ (gr, (Some _, Var ((name, _), _))) =
77.152 + | compile_expr _ _ _ (gr, (SOME _, Var ((name, _), _))) =
77.153 (gr, [Pretty.str name])
77.154 - | compile_expr thy dep brack (gr, (Some (Mode (mode, ms)), t)) =
77.155 + | compile_expr thy dep brack (gr, (SOME (Mode (mode, ms)), t)) =
77.156 let
77.157 val (Const (name, _), args) = strip_comb t;
77.158 val (gr', ps) = foldl_map
77.159 @@ -387,7 +387,7 @@
77.160 fun compile_clause thy gr dep all_vs arg_vs modes (iss, is) (ts, ps) =
77.161 let
77.162 val modes' = modes @ mapfilter
77.163 - (fn (_, None) => None | (v, Some js) => Some (v, [([], js)]))
77.164 + (fn (_, NONE) => NONE | (v, SOME js) => SOME (v, [([], js)]))
77.165 (arg_vs ~~ iss);
77.166
77.167 fun check_constrt ((names, eqs), t) =
77.168 @@ -427,7 +427,7 @@
77.169 | compile_prems out_ts vs names gr ps =
77.170 let
77.171 val vs' = distinct (flat (vs :: map term_vs out_ts));
77.172 - val Some (p, mode as Some (Mode ((_, js), _))) =
77.173 + val SOME (p, mode as SOME (Mode ((_, js), _))) =
77.174 select_mode_prem thy modes' vs' ps;
77.175 val ps' = filter_out (equal p) ps;
77.176 val ((names', eqs), out_ts') =
77.177 @@ -503,28 +503,28 @@
77.178 (string * (int list list option list * int list list)) list;
77.179
77.180 fun lookup_modes gr dep = apfst flat (apsnd flat (ListPair.unzip
77.181 - (map ((fn (Some (Modes x), _) => x | _ => ([], [])) o Graph.get_node gr)
77.182 + (map ((fn (SOME (Modes x), _) => x | _ => ([], [])) o Graph.get_node gr)
77.183 (Graph.all_preds gr [dep]))));
77.184
77.185 fun print_factors factors = message ("Factors:\n" ^
77.186 space_implode "\n" (map (fn (s, (fs, f)) => s ^ ": " ^
77.187 space_implode " -> " (map
77.188 - (fn None => "X" | Some f' => string_of_factors [] f')
77.189 - (fs @ [Some f]))) factors));
77.190 + (fn NONE => "X" | SOME f' => string_of_factors [] f')
77.191 + (fs @ [SOME f]))) factors));
77.192
77.193 fun prep_intrs intrs = map (rename_term o #prop o rep_thm o standard) intrs;
77.194
77.195 fun constrain cs [] = []
77.196 | constrain cs ((s, xs) :: ys) = (s, case assoc (cs, s) of
77.197 - None => xs
77.198 - | Some xs' => xs inter xs') :: constrain cs ys;
77.199 + NONE => xs
77.200 + | SOME xs' => xs inter xs') :: constrain cs ys;
77.201
77.202 fun mk_extra_defs thy gr dep names ts =
77.203 foldl (fn (gr, name) =>
77.204 if name mem names then gr
77.205 else (case get_clauses thy name of
77.206 - None => gr
77.207 - | Some (names, intrs) =>
77.208 + NONE => gr
77.209 + | SOME (names, intrs) =>
77.210 mk_ind_def thy gr dep names [] [] (prep_intrs intrs)))
77.211 (gr, foldr add_term_consts (ts, []))
77.212
77.213 @@ -539,8 +539,8 @@
77.214 fun dest_prem factors (_ $ (p as (Const ("op :", _) $ t $ u))) =
77.215 (case assoc (factors, case head_of u of
77.216 Const (name, _) => name | Var ((name, _), _) => name) of
77.217 - None => Prem (full_split_prod t, u)
77.218 - | Some f => Prem (split_prod [] f t, u))
77.219 + NONE => Prem (full_split_prod t, u)
77.220 + | SOME f => Prem (split_prod [] f t, u))
77.221 | dest_prem factors (_ $ ((eq as Const ("op =", _)) $ t $ u)) =
77.222 Prem ([t, u], eq)
77.223 | dest_prem factors (_ $ t) = Sidecond t;
77.224 @@ -562,20 +562,20 @@
77.225 fun add_prod_factors extra_fs (fs, _ $ (Const ("op :", _) $ t $ u)) =
77.226 if check_set (head_of u)
77.227 then infer_factors (sign_of thy) extra_fs
77.228 - (fs, (Some (FVar (prod_factors [] t)), u))
77.229 + (fs, (SOME (FVar (prod_factors [] t)), u))
77.230 else fs
77.231 | add_prod_factors _ (fs, _) = fs;
77.232
77.233 val gr' = mk_extra_defs thy
77.234 (Graph.add_edge (hd ids, dep)
77.235 - (Graph.new_node (hd ids, (None, "")) gr)) (hd ids) names intrs;
77.236 + (Graph.new_node (hd ids, (NONE, "")) gr)) (hd ids) names intrs;
77.237 val (extra_modes, extra_factors) = lookup_modes gr' (hd ids);
77.238 val fs = constrain factorcs (map (apsnd dest_factors)
77.239 (foldl (add_prod_factors extra_factors) ([], flat (map (fn t =>
77.240 Logic.strip_imp_concl t :: Logic.strip_imp_prems t) intrs))));
77.241 val factors = mapfilter (fn (name, f) =>
77.242 - if name mem arg_vs then None
77.243 - else Some (name, (map (curry assoc fs) arg_vs, f))) fs;
77.244 + if name mem arg_vs then NONE
77.245 + else SOME (name, (map (curry assoc fs) arg_vs, f))) fs;
77.246 val clauses =
77.247 foldl (add_clause (fs @ map (apsnd snd) extra_factors)) ([], intrs);
77.248 val modes = constrain modecs
77.249 @@ -585,19 +585,19 @@
77.250 val (gr'', s) = compile_preds thy gr' (hd ids) (terms_vs intrs) arg_vs
77.251 (modes @ extra_modes) clauses;
77.252 in
77.253 - (Graph.map_node (hd ids) (K (Some (Modes (modes, factors)), s)) gr'')
77.254 + (Graph.map_node (hd ids) (K (SOME (Modes (modes, factors)), s)) gr'')
77.255 end
77.256 end;
77.257
77.258 fun find_mode s u modes is = (case find_first (fn Mode ((_, js), _) => is=js)
77.259 (modes_of modes u handle OPTION => []) of
77.260 - None => error ("No such mode for " ^ s ^ ": " ^ string_of_mode ([], is))
77.261 + NONE => error ("No such mode for " ^ s ^ ": " ^ string_of_mode ([], is))
77.262 | mode => mode);
77.263
77.264 fun mk_ind_call thy gr dep t u is_query = (case head_of u of
77.265 Const (s, T) => (case (get_clauses thy s, get_assoc_code thy s T) of
77.266 - (None, _) => None
77.267 - | (Some (names, intrs), None) =>
77.268 + (NONE, _) => NONE
77.269 + | (SOME (names, intrs), NONE) =>
77.270 let
77.271 fun mk_mode (((ts, mode), i), Const ("dummy_pattern", _)) =
77.272 ((ts, mode), i+1)
77.273 @@ -615,16 +615,16 @@
77.274 (invoke_codegen thy dep false) (gr1, ts');
77.275 val (gr3, ps) = compile_expr thy dep false (gr2, (mode, u))
77.276 in
77.277 - Some (gr3, Pretty.block
77.278 + SOME (gr3, Pretty.block
77.279 (ps @ [Pretty.brk 1, mk_tuple in_ps]))
77.280 end
77.281 - | _ => None)
77.282 - | _ => None);
77.283 + | _ => NONE)
77.284 + | _ => NONE);
77.285
77.286 fun list_of_indset thy gr dep brack u = (case head_of u of
77.287 Const (s, T) => (case (get_clauses thy s, get_assoc_code thy s T) of
77.288 - (None, _) => None
77.289 - | (Some (names, intrs), None) =>
77.290 + (NONE, _) => NONE
77.291 + | (SOME (names, intrs), NONE) =>
77.292 let
77.293 val gr1 = mk_extra_defs thy
77.294 (mk_ind_def thy gr dep names [] [] (prep_intrs intrs)) dep names [u];
77.295 @@ -632,7 +632,7 @@
77.296 val mode = find_mode s u modes [];
77.297 val (gr2, ps) = compile_expr thy dep false (gr1, (mode, u))
77.298 in
77.299 - Some (gr2, (if brack then parens else I)
77.300 + SOME (gr2, (if brack then parens else I)
77.301 (Pretty.block ([Pretty.str "Seq.list_of", Pretty.brk 1,
77.302 Pretty.str "("] @
77.303 conv_ntuple' (snd (the (assoc (factors, s))))
77.304 @@ -640,8 +640,8 @@
77.305 (ps @ [Pretty.brk 1, Pretty.str "()"]) @
77.306 [Pretty.str ")"])))
77.307 end
77.308 - | _ => None)
77.309 - | _ => None);
77.310 + | _ => NONE)
77.311 + | _ => NONE);
77.312
77.313 fun clause_of_eqn eqn =
77.314 let
77.315 @@ -671,7 +671,7 @@
77.316 parens (Pretty.block [Pretty.str (modename thy pname ([], mode)),
77.317 Pretty.brk 1, mk_tuple vars])]) ^ ";\n\n";
77.318 val gr' = mk_ind_def thy (Graph.add_edge (id, dep)
77.319 - (Graph.new_node (id, (None, s)) gr)) id [pname]
77.320 + (Graph.new_node (id, (NONE, s)) gr)) id [pname]
77.321 [(pname, [([], mode)])]
77.322 [(pname, map (fn i => replicate i 2) (0 upto arity-1))]
77.323 clauses;
77.324 @@ -683,21 +683,21 @@
77.325
77.326 fun inductive_codegen thy gr dep brack (Const ("op :", _) $ t $ u) =
77.327 ((case mk_ind_call thy gr dep (Term.no_dummy_patterns t) u false of
77.328 - None => None
77.329 - | Some (gr', call_p) => Some (gr', (if brack then parens else I)
77.330 + NONE => NONE
77.331 + | SOME (gr', call_p) => SOME (gr', (if brack then parens else I)
77.332 (Pretty.block [Pretty.str "?! (", call_p, Pretty.str ")"])))
77.333 handle TERM _ => mk_ind_call thy gr dep t u true)
77.334 | inductive_codegen thy gr dep brack t = (case strip_comb t of
77.335 (Const (s, _), ts) => (case Symtab.lookup (#eqns (CodegenData.get thy), s) of
77.336 - None => list_of_indset thy gr dep brack t
77.337 - | Some eqns =>
77.338 + NONE => list_of_indset thy gr dep brack t
77.339 + | SOME eqns =>
77.340 let
77.341 val gr' = mk_fun thy s (preprocess thy eqns) dep gr
77.342 val (gr'', ps) = foldl_map (invoke_codegen thy dep true) (gr', ts);
77.343 - in Some (gr'', mk_app brack (Pretty.str (mk_const_id
77.344 + in SOME (gr'', mk_app brack (Pretty.str (mk_const_id
77.345 (sign_of thy) s)) ps)
77.346 end)
77.347 - | _ => None);
77.348 + | _ => NONE);
77.349
77.350 val setup =
77.351 [add_codegen "inductive" inductive_codegen,
78.1 --- a/src/HOL/Tools/inductive_package.ML Fri Feb 11 18:51:00 2005 +0100
78.2 +++ b/src/HOL/Tools/inductive_package.ML Sun Feb 13 17:15:14 2005 +0100
78.3 @@ -116,8 +116,8 @@
78.4
78.5 fun the_inductive thy name =
78.6 (case get_inductive thy name of
78.7 - None => error ("Unknown (co)inductive set " ^ quote name)
78.8 - | Some info => info);
78.9 + NONE => error ("Unknown (co)inductive set " ^ quote name)
78.10 + | SOME info => info);
78.11
78.12 val the_mk_cases = (#mk_cases o #2) oo the_inductive;
78.13
78.14 @@ -387,20 +387,20 @@
78.15
78.16 fun subst (s as ((m as Const ("op :", T)) $ t $ u)) =
78.17 (case pred_of u of
78.18 - None => (m $ fst (subst t) $ fst (subst u), None)
78.19 - | Some P => (HOLogic.mk_binop inductive_conj_name (s, P $ t), Some (s, P $ t)))
78.20 + NONE => (m $ fst (subst t) $ fst (subst u), NONE)
78.21 + | SOME P => (HOLogic.mk_binop inductive_conj_name (s, P $ t), SOME (s, P $ t)))
78.22 | subst s =
78.23 (case pred_of s of
78.24 - Some P => (HOLogic.mk_binop "op Int"
78.25 + SOME P => (HOLogic.mk_binop "op Int"
78.26 (s, HOLogic.Collect_const (HOLogic.dest_setT
78.27 - (fastype_of s)) $ P), None)
78.28 - | None => (case s of
78.29 - (t $ u) => (fst (subst t) $ fst (subst u), None)
78.30 - | (Abs (a, T, t)) => (Abs (a, T, fst (subst t)), None)
78.31 - | _ => (s, None)));
78.32 + (fastype_of s)) $ P), NONE)
78.33 + | NONE => (case s of
78.34 + (t $ u) => (fst (subst t) $ fst (subst u), NONE)
78.35 + | (Abs (a, T, t)) => (Abs (a, T, fst (subst t)), NONE)
78.36 + | _ => (s, NONE)));
78.37
78.38 fun mk_prem (s, prems) = (case subst s of
78.39 - (_, Some (t, u)) => t :: u :: prems
78.40 + (_, SOME (t, u)) => t :: u :: prems
78.41 | (t, _) => t :: prems);
78.42
78.43 val Const ("op :", _) $ t $ u =
78.44 @@ -562,8 +562,8 @@
78.45 fun mk_elim rl = Drule.standard (Tactic.rule_by_tactic tac (prem RS rl));
78.46 in
78.47 (case get_first (try mk_elim) elims of
78.48 - Some r => r
78.49 - | None => error (Pretty.string_of (Pretty.block
78.50 + SOME r => r
78.51 + | NONE => error (Pretty.string_of (Pretty.block
78.52 [Pretty.str mk_cases_err, Pretty.fbrk, Display.pretty_cterm cprop])))
78.53 end;
78.54
78.55 @@ -617,11 +617,11 @@
78.56 val sign = Theory.sign_of thy;
78.57
78.58 val sum_case_rewrites =
78.59 - (if PureThy.get_name thy = "Datatype" then PureThy.get_thms thy ("sum.cases", None)
78.60 + (if PureThy.get_name thy = "Datatype" then PureThy.get_thms thy ("sum.cases", NONE)
78.61 else
78.62 (case ThyInfo.lookup_theory "Datatype" of
78.63 - None => []
78.64 - | Some thy' => PureThy.get_thms thy' ("sum.cases", None))) |> map mk_meta_eq;
78.65 + NONE => []
78.66 + | SOME thy' => PureThy.get_thms thy' ("sum.cases", NONE))) |> map mk_meta_eq;
78.67
78.68 val (preds, ind_prems, mutual_ind_concl, factors) =
78.69 mk_indrule cs cTs params intr_ts;
78.70 @@ -817,8 +817,8 @@
78.71
78.72 fun try_term f msg sign t =
78.73 (case Library.try f t of
78.74 - Some x => x
78.75 - | None => error (msg ^ Sign.string_of_term sign t));
78.76 + SOME x => x
78.77 + | NONE => error (msg ^ Sign.string_of_term sign t));
78.78
78.79 fun add_inductive_i verbose declare_consts alt_name coind no_elim no_ind cs pre_intros monos thy =
78.80 let
79.1 --- a/src/HOL/Tools/inductive_realizer.ML Fri Feb 11 18:51:00 2005 +0100
79.2 +++ b/src/HOL/Tools/inductive_realizer.ML Sun Feb 13 17:15:14 2005 +0100
79.3 @@ -23,7 +23,7 @@
79.4
79.5 fun forall_intr_prf (t, prf) =
79.6 let val (a, T) = (case t of Var ((a, _), T) => (a, T) | Free p => p)
79.7 - in Abst (a, Some T, Proofterm.prf_abstract_over t prf) end;
79.8 + in Abst (a, SOME T, Proofterm.prf_abstract_over t prf) end;
79.9
79.10 fun subsets [] = [[]]
79.11 | subsets (x::xs) =
79.12 @@ -75,7 +75,7 @@
79.13 fun gen_rvar vs (t as Var ((a, 0), T)) =
79.14 let val U = TVar (("'" ^ a, 0), HOLogic.typeS)
79.15 in case try HOLogic.dest_setT T of
79.16 - None => if body_type T <> HOLogic.boolT then t else
79.17 + NONE => if body_type T <> HOLogic.boolT then t else
79.18 let
79.19 val Ts = binder_types T;
79.20 val i = length Ts;
79.21 @@ -86,7 +86,7 @@
79.22 list_abs (("r", U) :: xs, mk_rlz U $ Bound i $ u)
79.23 else list_abs (xs, mk_rlz Extraction.nullT $ Extraction.nullt $ u)
79.24 end
79.25 - | Some T' => if a mem vs then
79.26 + | SOME T' => if a mem vs then
79.27 Abs ("r", U, Abs ("x", T', mk_rlz U $ Bound 1 $
79.28 (HOLogic.mk_mem (Bound 0, t))))
79.29 else Abs ("x", T', mk_rlz Extraction.nullT $ Extraction.nullt $
79.30 @@ -112,7 +112,7 @@
79.31 val rname = space_implode "_" (s ^ "R" :: vs);
79.32
79.33 fun mk_Tprem n v =
79.34 - let val Some T = assoc (rvs, v)
79.35 + let val SOME T = assoc (rvs, v)
79.36 in (Const ("typeof", T --> Type ("Type", [])) $ Var ((v, 0), T),
79.37 Extraction.mk_typ (if n then Extraction.nullT
79.38 else TVar (("'" ^ v, 0), HOLogic.typeS)))
79.39 @@ -199,11 +199,11 @@
79.40 let
79.41 val concls = HOLogic.dest_conj (HOLogic.dest_Trueprop (concl_of raw_induct));
79.42 val premss = mapfilter (fn (s, rs) => if s mem rsets then
79.43 - Some (map (fn r => nth_elem (find_index_eq (prop_of r) (map prop_of intrs),
79.44 - prems_of raw_induct)) rs) else None) rss;
79.45 + SOME (map (fn r => nth_elem (find_index_eq (prop_of r) (map prop_of intrs),
79.46 + prems_of raw_induct)) rs) else NONE) rss;
79.47 val concls' = mapfilter (fn (s, _) => if s mem rsets then
79.48 find_first (fn concl => s mem term_consts concl) concls
79.49 - else None) rss;
79.50 + else NONE) rss;
79.51 val fs = flat (snd (foldl_map (fn (intrs, (prems, dummy)) =>
79.52 let
79.53 val (intrs1, intrs2) = splitAt (length prems, intrs);
79.54 @@ -217,8 +217,8 @@
79.55 val Ts = map fastype_of fs;
79.56 val rlzs = mapfilter (fn (a, concl) =>
79.57 let val T = Extraction.etype_of thy vs [] concl
79.58 - in if T = Extraction.nullT then None
79.59 - else Some (list_comb (Const (a, Ts ---> T), fs))
79.60 + in if T = Extraction.nullT then NONE
79.61 + else SOME (list_comb (Const (a, Ts ---> T), fs))
79.62 end) (rec_names ~~ concls')
79.63 in if null rlzs then Extraction.nullt else
79.64 let
79.65 @@ -259,8 +259,8 @@
79.66 fun mk_prf _ [] prf = prf
79.67 | mk_prf rs ((prem, rprem) :: prems) prf =
79.68 if Extraction.etype_of thy vs [] prem = Extraction.nullT
79.69 - then AbsP ("H", Some rprem, mk_prf rs prems prf)
79.70 - else forall_intr_prf (Var (hd rs), AbsP ("H", Some rprem,
79.71 + then AbsP ("H", SOME rprem, mk_prf rs prems prf)
79.72 + else forall_intr_prf (Var (hd rs), AbsP ("H", SOME rprem,
79.73 mk_prf (tl rs) prems prf));
79.74
79.75 in (Thm.name_of_thm rule, (vs,
79.76 @@ -301,13 +301,13 @@
79.77 (s, replicate ar HOLogic.typeS, HOLogic.typeS)) tnames) |>
79.78 Extraction.add_typeof_eqns_i ty_eqs;
79.79 val dts = mapfilter (fn (s, rs) => if s mem rsets then
79.80 - Some (dt_of_intrs thy1' vs rs) else None) rss;
79.81 + SOME (dt_of_intrs thy1' vs rs) else NONE) rss;
79.82
79.83 (** datatype representing computational content of inductive set **)
79.84
79.85 val (thy2, (dummies, dt_info)) = thy1 |>
79.86 - (if null dts then rpair ([], None) else
79.87 - apsnd (apsnd Some) o add_dummies (DatatypePackage.add_datatype_i false false
79.88 + (if null dts then rpair ([], NONE) else
79.89 + apsnd (apsnd SOME) o add_dummies (DatatypePackage.add_datatype_i false false
79.90 (map #2 dts)) (map (pair false) dts) []) |>>
79.91 Extraction.add_typeof_eqns_i ty_eqs |>>
79.92 Extraction.add_realizes_eqns_i rlz_eqs;
79.93 @@ -346,7 +346,7 @@
79.94 (** realizer for induction rule **)
79.95
79.96 val Ps = mapfilter (fn _ $ M $ P => if set_of M mem rsets then
79.97 - Some (fst (fst (dest_Var (head_of P)))) else None)
79.98 + SOME (fst (fst (dest_Var (head_of P)))) else NONE)
79.99 (HOLogic.dest_conj (HOLogic.dest_Trueprop (concl_of raw_induct)));
79.100
79.101 fun add_ind_realizer (thy, Ps) =
79.102 @@ -434,7 +434,7 @@
79.103 val elimps = mapfilter (fn (s, intrs) => if s mem rsets then
79.104 apsome (rpair intrs) (find_first (fn (thm, _) =>
79.105 s mem term_consts (hd (prems_of thm))) (elims ~~ #elims ind_info))
79.106 - else None) rss;
79.107 + else NONE) rss;
79.108 val thy6 = foldl (fn (thy, p as (((((elim, _), _), _), _), _)) => thy |>
79.109 add_elim_realizer [] p |> add_elim_realizer [fst (fst (dest_Var
79.110 (HOLogic.dest_Trueprop (concl_of elim))))] p) (thy5,
79.111 @@ -446,8 +446,8 @@
79.112 let
79.113 val (_, {intrs, induct, raw_induct, elims, ...}) =
79.114 (case InductivePackage.get_inductive thy name of
79.115 - None => error ("Unknown inductive set " ^ quote name)
79.116 - | Some info => info);
79.117 + NONE => error ("Unknown inductive set " ^ quote name)
79.118 + | SOME info => info);
79.119 val _ $ (_ $ _ $ S) = concl_of (hd intrs);
79.120 val vss = sort (int_ord o pairself length)
79.121 (subsets (map fst (relevant_vars S)))
79.122 @@ -465,8 +465,8 @@
79.123 handle TERM _ => err () | LIST _ => err ();
79.124 in
79.125 (add_ind_realizers (hd sets) (case arg of
79.126 - None => sets | Some None => []
79.127 - | Some (Some sets') => sets \\ map (Sign.intern_const (sign_of thy)) sets')
79.128 + NONE => sets | SOME NONE => []
79.129 + | SOME (SOME sets') => sets \\ map (Sign.intern_const (sign_of thy)) sets')
79.130 thy, thm)
79.131 end;
79.132
80.1 --- a/src/HOL/Tools/meson.ML Fri Feb 11 18:51:00 2005 +0100
80.2 +++ b/src/HOL/Tools/meson.ML Sun Feb 13 17:15:14 2005 +0100
80.3 @@ -44,8 +44,8 @@
80.4 (*Permits forward proof from rules that discharge assumptions*)
80.5 fun forward_res nf st =
80.6 case Seq.pull (ALLGOALS (METAHYPS (fn [prem] => rtac (nf prem) 1)) st)
80.7 - of Some(th,_) => th
80.8 - | None => raise THM("forward_res", 0, [st]);
80.9 + of SOME(th,_) => th
80.10 + | NONE => raise THM("forward_res", 0, [st]);
80.11
80.12
80.13 (*Are any of the constants in "bs" present in the term?*)
80.14 @@ -126,8 +126,8 @@
80.15 (REPEAT
80.16 (METAHYPS (fn major::minors => rtac (nf (minors@hyps) major) 1) 1)
80.17 st)
80.18 - of Some(th,_) => th
80.19 - | None => raise THM("forward_res2", 0, [st]);
80.20 + of SOME(th,_) => th
80.21 + | NONE => raise THM("forward_res2", 0, [st]);
80.22
80.23 (*Remove duplicates in P|Q by assuming ~P in Q
80.24 rls (initially []) accumulates assumptions of the form P==>False*)
81.1 --- a/src/HOL/Tools/primrec_package.ML Fri Feb 11 18:51:00 2005 +0100
81.2 +++ b/src/HOL/Tools/primrec_package.ML Sun Feb 13 17:15:14 2005 +0100
81.3 @@ -73,9 +73,9 @@
81.4 check_vars "extra variables on rhs: "
81.5 (map dest_Free (term_frees rhs) \\ lfrees);
81.6 case assoc (rec_fns, fname) of
81.7 - None =>
81.8 + NONE =>
81.9 (fname, (tname, rpos, [(cname, (ls, cargs, rs, rhs, eq))]))::rec_fns
81.10 - | Some (_, rpos', eqns) =>
81.11 + | SOME (_, rpos', eqns) =>
81.12 if is_some (assoc (eqns, cname)) then
81.13 raise RecError "constructor already occurred as pattern"
81.14 else if rpos <> rpos' then
81.15 @@ -113,11 +113,11 @@
81.16 val (x, xs) = strip_comb x'
81.17 in
81.18 (case assoc (subs, x) of
81.19 - None =>
81.20 + NONE =>
81.21 let
81.22 val (fs', ts') = foldl_map (subst subs) (fs, ts)
81.23 in (fs', list_comb (f, ts')) end
81.24 - | Some (i', y) =>
81.25 + | SOME (i', y) =>
81.26 let
81.27 val (fs', ts') = foldl_map (subst subs) (fs, xs @ ls @ rs);
81.28 val fs'' = process_fun sign descr rec_eqns ((i', fname'), fs')
81.29 @@ -135,10 +135,10 @@
81.30
81.31 fun trans eqns ((cname, cargs), (fnames', fnss', fns)) =
81.32 (case assoc (eqns, cname) of
81.33 - None => (warning ("No equation for constructor " ^ quote cname ^
81.34 + NONE => (warning ("No equation for constructor " ^ quote cname ^
81.35 "\nin definition of function " ^ quote fname);
81.36 (fnames', fnss', (Const ("arbitrary", dummyT))::fns))
81.37 - | Some (ls, cargs', rs, rhs, eq) =>
81.38 + | SOME (ls, cargs', rs, rhs, eq) =>
81.39 let
81.40 val recs = filter (is_rec_type o snd) (cargs' ~~ cargs);
81.41 val rargs = map fst recs;
81.42 @@ -155,7 +155,7 @@
81.43 end)
81.44
81.45 in (case assoc (fnames, i) of
81.46 - None =>
81.47 + NONE =>
81.48 if exists (equal fname o snd) fnames then
81.49 raise RecError ("inconsistent functions for datatype " ^ quote tname)
81.50 else
81.51 @@ -166,7 +166,7 @@
81.52 in
81.53 (fnames', (i, (fname, #1 (snd (hd eqns)), fns))::fnss')
81.54 end
81.55 - | Some fname' =>
81.56 + | SOME fname' =>
81.57 if fname = fname' then (fnames, fnss)
81.58 else raise RecError ("inconsistent functions for datatype " ^ quote tname))
81.59 end;
81.60 @@ -176,7 +176,7 @@
81.61
81.62 fun get_fns fns (((i, (tname, _, constrs)), rec_name), (fs, defs)) =
81.63 case assoc (fns, i) of
81.64 - None =>
81.65 + NONE =>
81.66 let
81.67 val dummy_fns = map (fn (_, cargs) => Const ("arbitrary",
81.68 replicate ((length cargs) + (length (filter is_rec_type cargs)))
81.69 @@ -185,7 +185,7 @@
81.70 in
81.71 (dummy_fns @ fs, defs)
81.72 end
81.73 - | Some (fname, ls, fs') => (fs' @ fs, (fname, ls, rec_name, tname)::defs);
81.74 + | SOME (fname, ls, fs') => (fs' @ fs, (fname, ls, rec_name, tname)::defs);
81.75
81.76
81.77 (* make definition *)
81.78 @@ -206,8 +206,8 @@
81.79 fun find_dts (dt_info : datatype_info Symtab.table) _ [] = []
81.80 | find_dts dt_info tnames' (tname::tnames) =
81.81 (case Symtab.lookup (dt_info, tname) of
81.82 - None => primrec_err (quote tname ^ " is not a datatype")
81.83 - | Some dt =>
81.84 + NONE => primrec_err (quote tname ^ " is not a datatype")
81.85 + | SOME dt =>
81.86 if tnames' subset (map (#1 o snd) (#descr dt)) then
81.87 (tname, dt)::(find_dts dt_info tnames' tnames)
81.88 else find_dts dt_info tnames' tnames);
82.1 --- a/src/HOL/Tools/recdef_package.ML Fri Feb 11 18:51:00 2005 +0100
82.2 +++ b/src/HOL/Tools/recdef_package.ML Sun Feb 13 17:15:14 2005 +0100
82.3 @@ -210,8 +210,8 @@
82.4 val ctxt0 = ProofContext.init thy;
82.5 val ctxt =
82.6 (case opt_src of
82.7 - None => ctxt0
82.8 - | Some src => Method.only_sectioned_args recdef_modifiers I src ctxt0);
82.9 + NONE => ctxt0
82.10 + | SOME src => Method.only_sectioned_args recdef_modifiers I src ctxt0);
82.11 val {simps, congs, wfs} = get_local_hints ctxt;
82.12 val cs = local_claset_of ctxt;
82.13 val ss = local_simpset_of ctxt addsimps simps;
82.14 @@ -310,8 +310,8 @@
82.15 val atts = map (prep_att thy) raw_atts;
82.16 val tcs =
82.17 (case get_recdef thy name of
82.18 - None => error ("No recdef definition of constant: " ^ quote name)
82.19 - | Some {tcs, ...} => tcs);
82.20 + NONE => error ("No recdef definition of constant: " ^ quote name)
82.21 + | SOME {tcs, ...} => tcs);
82.22 val i = if_none opt_i 1;
82.23 val tc = Library.nth_elem (i - 1, tcs) handle Library.LIST _ =>
82.24 error ("No termination condition #" ^ string_of_int i ^
83.1 --- a/src/HOL/Tools/recfun_codegen.ML Fri Feb 11 18:51:00 2005 +0100
83.2 +++ b/src/HOL/Tools/recfun_codegen.ML Sun Feb 13 17:15:14 2005 +0100
83.3 @@ -53,8 +53,8 @@
83.4 val tab = CodegenData.get thy;
83.5 val (s, _) = const_of (prop_of thm);
83.6 in case Symtab.lookup (tab, s) of
83.7 - None => p
83.8 - | Some thms => (CodegenData.put (Symtab.update ((s,
83.9 + NONE => p
83.10 + | SOME thms => (CodegenData.put (Symtab.update ((s,
83.11 gen_rem eq_thm (thms, thm)), tab)) thy, thm)
83.12 end handle TERM _ => (warn thm; p);
83.13
83.14 @@ -68,14 +68,14 @@
83.15
83.16 fun get_equations thy (s, T) =
83.17 (case Symtab.lookup (CodegenData.get thy, s) of
83.18 - None => []
83.19 - | Some thms => preprocess thy (del_redundant thy []
83.20 + NONE => []
83.21 + | SOME thms => preprocess thy (del_redundant thy []
83.22 (filter (fn thm => is_instance thy T
83.23 (snd (const_of (prop_of thm)))) thms)));
83.24
83.25 fun mk_poly_id thy (s, T) = mk_const_id (sign_of thy) s ^
83.26 (case get_defn thy s T of
83.27 - Some (_, Some i) => "_def" ^ string_of_int i
83.28 + SOME (_, SOME i) => "_def" ^ string_of_int i
83.29 | _ => "");
83.30
83.31 exception EQN of string * typ * string;
83.32 @@ -104,19 +104,19 @@
83.33 end;
83.34
83.35 fun put_code fundef = Graph.map_node dname
83.36 - (K (Some (EQN ("", dummyT, dname)), Pretty.string_of (Pretty.blk (0,
83.37 + (K (SOME (EQN ("", dummyT, dname)), Pretty.string_of (Pretty.blk (0,
83.38 separate Pretty.fbrk fundef @ [Pretty.str ";"])) ^ "\n\n"));
83.39
83.40 in
83.41 (case try (Graph.get_node gr) dname of
83.42 - None =>
83.43 + NONE =>
83.44 let
83.45 val gr1 = Graph.add_edge (dname, dep)
83.46 - (Graph.new_node (dname, (Some (EQN (s, T, "")), "")) gr);
83.47 + (Graph.new_node (dname, (SOME (EQN (s, T, "")), "")) gr);
83.48 val (gr2, fundef) = mk_fundef "" "fun " gr1 eqs';
83.49 val xs = cycle gr2 ([], dname);
83.50 val cs = map (fn x => case Graph.get_node gr2 x of
83.51 - (Some (EQN (s, T, _)), _) => (s, T)
83.52 + (SOME (EQN (s, T, _)), _) => (s, T)
83.53 | _ => error ("RecfunCodegen: illegal cyclic dependencies:\n" ^
83.54 implode (separate ", " xs))) xs
83.55 in (case xs of
83.56 @@ -129,12 +129,12 @@
83.57 val (gr3, fundef') = mk_fundef "" "fun "
83.58 (Graph.add_edge (dname, dep)
83.59 (foldr (uncurry Graph.new_node) (map (fn k =>
83.60 - (k, (Some (EQN ("", dummyT, dname)), ""))) xs,
83.61 + (k, (SOME (EQN ("", dummyT, dname)), ""))) xs,
83.62 Graph.del_nodes xs gr2))) eqs''
83.63 in put_code fundef' gr3 end
83.64 else gr2)
83.65 end
83.66 - | Some (Some (EQN (_, _, s)), _) =>
83.67 + | SOME (SOME (EQN (_, _, s)), _) =>
83.68 if s = "" then
83.69 if dname = dep then gr else Graph.add_edge (dname, dep) gr
83.70 else if s = dep then gr else Graph.add_edge (s, dep) gr)
83.71 @@ -142,15 +142,15 @@
83.72
83.73 fun recfun_codegen thy gr dep brack t = (case strip_comb t of
83.74 (Const (p as (s, T)), ts) => (case (get_equations thy p, get_assoc_code thy s T) of
83.75 - ([], _) => None
83.76 - | (_, Some _) => None
83.77 - | (eqns, None) =>
83.78 + ([], _) => NONE
83.79 + | (_, SOME _) => NONE
83.80 + | (eqns, NONE) =>
83.81 let val (gr', ps) = foldl_map (invoke_codegen thy dep true) (gr, ts)
83.82 in
83.83 - Some (add_rec_funs thy gr' dep (map prop_of eqns),
83.84 + SOME (add_rec_funs thy gr' dep (map prop_of eqns),
83.85 mk_app brack (Pretty.str (mk_poly_id thy p)) ps)
83.86 end)
83.87 - | _ => None);
83.88 + | _ => NONE);
83.89
83.90
83.91 val setup =
84.1 --- a/src/HOL/Tools/reconstruction.ML Fri Feb 11 18:51:00 2005 +0100
84.2 +++ b/src/HOL/Tools/reconstruction.ML Sun Feb 13 17:15:14 2005 +0100
84.3 @@ -149,11 +149,11 @@
84.4 case Thm.name_of_thm th of
84.5 "" => ResAxioms.meta_cnf_axiom th (*no name, so can't cache*)
84.6 | s => case Symtab.lookup (!cc,s) of
84.7 - None =>
84.8 + NONE =>
84.9 let val cls = ResAxioms.meta_cnf_axiom th
84.10 in cc := Symtab.update ((s, (th,cls)), !cc); cls
84.11 end
84.12 - | Some(th',cls) =>
84.13 + | SOME(th',cls) =>
84.14 if eq_thm(th,th') then cls
84.15 else (*New theorem stored under the same name? Possible??*)
84.16 let val cls = ResAxioms.meta_cnf_axiom th
85.1 --- a/src/HOL/Tools/record_package.ML Fri Feb 11 18:51:00 2005 +0100
85.2 +++ b/src/HOL/Tools/record_package.ML Sun Feb 13 17:15:14 2005 +0100
85.3 @@ -82,8 +82,8 @@
85.4 (*** utilities ***)
85.5
85.6 fun but_last xs = fst (split_last xs);
85.7 -fun list None = []
85.8 - | list (Some x) = [x]
85.9 +fun list NONE = []
85.10 + | list (SOME x) = [x]
85.11
85.12 (* messages *)
85.13
85.14 @@ -159,12 +159,12 @@
85.15
85.16 fun dest_recT (typ as Type (c_ext_type, Ts as (T::_))) =
85.17 (case try (unsuffix ext_typeN) c_ext_type of
85.18 - None => raise TYPE ("RecordPackage.dest_recT", [typ], [])
85.19 - | Some c => ((c, Ts), last_elem Ts))
85.20 + NONE => raise TYPE ("RecordPackage.dest_recT", [typ], [])
85.21 + | SOME c => ((c, Ts), last_elem Ts))
85.22 | dest_recT typ = raise TYPE ("RecordPackage.dest_recT", [typ], []);
85.23
85.24 fun is_recT T =
85.25 - (case try dest_recT T of None => false | Some _ => true);
85.26 + (case try dest_recT T of NONE => false | SOME _ => true);
85.27
85.28 fun dest_recTs T =
85.29 let val ((c, Ts), U) = dest_recT T
85.30 @@ -174,9 +174,9 @@
85.31 fun last_extT T =
85.32 let val ((c, Ts), U) = dest_recT T
85.33 in (case last_extT U of
85.34 - None => Some (c,Ts)
85.35 - | Some l => Some l)
85.36 - end handle TYPE _ => None
85.37 + NONE => SOME (c,Ts)
85.38 + | SOME l => SOME l)
85.39 + end handle TYPE _ => NONE
85.40
85.41 fun rec_id i T =
85.42 let val rTs = dest_recTs T
85.43 @@ -282,8 +282,8 @@
85.44 let
85.45 val prt_typ = Sign.pretty_typ sg;
85.46
85.47 - fun pretty_parent None = []
85.48 - | pretty_parent (Some (Ts, name)) =
85.49 + fun pretty_parent NONE = []
85.50 + | pretty_parent (SOME (Ts, name)) =
85.51 [Pretty.block [prt_typ (Type (name, Ts)), Pretty.str " +"]];
85.52
85.53 fun pretty_field (c, T) = Pretty.block
85.54 @@ -319,8 +319,8 @@
85.55 fun get_selectors sg name = Symtab.lookup (#selectors (get_sel_upd sg), name);
85.56 fun is_selector sg name =
85.57 case get_selectors sg (Sign.intern_const sg name) of
85.58 - None => false
85.59 - | Some _ => true
85.60 + NONE => false
85.61 + | SOME _ => true
85.62
85.63
85.64 fun get_updates sg name = Symtab.lookup (#updates (get_sel_upd sg), name);
85.65 @@ -399,8 +399,8 @@
85.66 (* extension of a record name *)
85.67 fun get_extension sg name =
85.68 case Symtab.lookup (#records (RecordsData.get_sg sg),name) of
85.69 - Some s => Some (#extension s)
85.70 - | None => None;
85.71 + SOME s => SOME (#extension s)
85.72 + | NONE => NONE;
85.73
85.74 (* access 'extfields' *)
85.75
85.76 @@ -461,18 +461,18 @@
85.77
85.78 (* parent records *)
85.79
85.80 -fun add_parents thy None parents = parents
85.81 - | add_parents thy (Some (types, name)) parents =
85.82 +fun add_parents thy NONE parents = parents
85.83 + | add_parents thy (SOME (types, name)) parents =
85.84 let
85.85 val sign = Theory.sign_of thy;
85.86 fun err msg = error (msg ^ " parent record " ^ quote name);
85.87
85.88 val {args, parent, fields, extension, induct} =
85.89 - (case get_record thy name of Some info => info | None => err "Unknown");
85.90 + (case get_record thy name of SOME info => info | NONE => err "Unknown");
85.91 val _ = if length types <> length args then err "Bad number of arguments for" else ();
85.92
85.93 fun bad_inst ((x, S), T) =
85.94 - if Sign.of_sort sign (T, S) then None else Some x
85.95 + if Sign.of_sort sign (T, S) then NONE else SOME x
85.96 val bads = mapfilter bad_inst (args ~~ types);
85.97
85.98 val inst = map fst args ~~ types;
85.99 @@ -537,16 +537,16 @@
85.100
85.101 fun mk_ext (fargs as (name,arg)::_) =
85.102 (case get_fieldext sg (Sign.intern_const sg name) of
85.103 - Some (ext,_) => (case get_extfields sg ext of
85.104 - Some flds
85.105 + SOME (ext,_) => (case get_extfields sg ext of
85.106 + SOME flds
85.107 => let val (args,rest) =
85.108 splitargs (map fst (but_last flds)) fargs;
85.109 val more' = mk_ext rest;
85.110 in list_comb (Syntax.const (suffix sfx ext),args@[more'])
85.111 end
85.112 - | None => raise TERM(msg ^ "no fields defined for "
85.113 + | NONE => raise TERM(msg ^ "no fields defined for "
85.114 ^ ext,[t]))
85.115 - | None => raise TERM (msg ^ name ^" is no proper field",[t]))
85.116 + | NONE => raise TERM (msg ^ name ^" is no proper field",[t]))
85.117 | mk_ext [] = more
85.118
85.119 in mk_ext fieldargs end;
85.120 @@ -565,8 +565,8 @@
85.121 | splitargs _ _ = ([],[]);
85.122
85.123 fun get_sort xs n = (case assoc (xs,n) of
85.124 - Some s => s
85.125 - | None => Sign.defaultS sg);
85.126 + SOME s => s
85.127 + | NONE => Sign.defaultS sg);
85.128 fun to_type t = Sign.intern_typ sg
85.129 (Syntax.typ_of_term (get_sort (Syntax.raw_term_sorts t)) I t);
85.130
85.131 @@ -575,9 +575,9 @@
85.132
85.133 fun mk_ext (fargs as (name,arg)::_) =
85.134 (case get_fieldext sg (Sign.intern_const sg name) of
85.135 - Some (ext,alphas) =>
85.136 + SOME (ext,alphas) =>
85.137 (case get_extfields sg ext of
85.138 - Some flds
85.139 + SOME flds
85.140 => (let
85.141 val flds' = but_last flds;
85.142 val types = map snd flds';
85.143 @@ -593,8 +593,8 @@
85.144 in list_comb (Syntax.const (suffix sfx ext),alphas'@[more'])
85.145 end handle TUNIFY => raise
85.146 TERM (msg ^ "type is no proper record (extension)", [t]))
85.147 - | None => raise TERM (msg ^ "no fields defined for " ^ ext,[t]))
85.148 - | None => raise TERM (msg ^ name ^" is no proper field",[t]))
85.149 + | NONE => raise TERM (msg ^ "no fields defined for " ^ ext,[t]))
85.150 + | NONE => raise TERM (msg ^ name ^" is no proper field",[t]))
85.151 | mk_ext [] = more
85.152
85.153 in mk_ext fieldargs end;
85.154 @@ -642,9 +642,9 @@
85.155
85.156 fun gen_field_upds_tr' mark sfx (tm as Const (name_field, _) $ t $ u) =
85.157 (case try (unsuffix sfx) name_field of
85.158 - Some name =>
85.159 + SOME name =>
85.160 apfst (cons (Syntax.const mark $ Syntax.free name $ t)) (gen_field_upds_tr' mark sfx u)
85.161 - | None => ([], tm))
85.162 + | NONE => ([], tm))
85.163 | gen_field_upds_tr' _ _ tm = ([], tm);
85.164
85.165 fun record_update_tr' tm =
85.166 @@ -663,17 +663,17 @@
85.167 (case strip_comb t of
85.168 (Const (ext,_),args)
85.169 => (case try (unsuffix extN) (Sign.intern_const sg ext) of
85.170 - Some ext'
85.171 + SOME ext'
85.172 => (case get_extfields sg ext' of
85.173 - Some flds
85.174 + SOME flds
85.175 => (let
85.176 val (f::fs) = but_last (map fst flds);
85.177 val flds' = Sign.extern sg Sign.constK f::map NameSpace.base fs;
85.178 val (args',more) = split_last args;
85.179 in (flds'~~args')@field_lst more end
85.180 handle LIST _ => [("",t)])
85.181 - | None => [("",t)])
85.182 - | None => [("",t)])
85.183 + | NONE => [("",t)])
85.184 + | NONE => [("",t)])
85.185 | _ => [("",t)])
85.186
85.187 val (flds,(_,more)) = split_last (field_lst t);
85.188 @@ -705,8 +705,8 @@
85.189 (* type from tm so that we can continue on the type level rather then the term level.*)
85.190
85.191 fun get_sort xs n = (case assoc (xs,n) of
85.192 - Some s => s
85.193 - | None => Sign.defaultS sg);
85.194 + SOME s => s
85.195 + | NONE => Sign.defaultS sg);
85.196
85.197 (* WORKAROUND:
85.198 * If a record type occurs in an error message of type inference there
85.199 @@ -734,7 +734,7 @@
85.200
85.201 in if !print_record_type_abbr
85.202 then (case last_extT T of
85.203 - Some (name,_)
85.204 + SOME (name,_)
85.205 => if name = lastExt
85.206 then
85.207 (let
85.208 @@ -752,8 +752,8 @@
85.209 fun record_type_tr' sep mark record record_scheme sg t =
85.210 let
85.211 fun get_sort xs n = (case assoc (xs,n) of
85.212 - Some s => s
85.213 - | None => Sign.defaultS sg);
85.214 + SOME s => s
85.215 + | NONE => Sign.defaultS sg);
85.216
85.217 val T = Sign.intern_typ sg (Syntax.typ_of_term (get_sort (Syntax.raw_term_sorts t)) I t)
85.218
85.219 @@ -766,11 +766,11 @@
85.220 (case T of
85.221 Type (ext,args)
85.222 => (case try (unsuffix ext_typeN) ext of
85.223 - Some ext'
85.224 + SOME ext'
85.225 => (case get_extfields sg ext' of
85.226 - Some flds
85.227 + SOME flds
85.228 => (case get_fieldext sg (fst (hd flds)) of
85.229 - Some (_,alphas)
85.230 + SOME (_,alphas)
85.231 => (let
85.232 val (f::fs) = but_last flds;
85.233 val flds' = apfst (Sign.extern sg Sign.constK) f
85.234 @@ -783,9 +783,9 @@
85.235 in flds''@field_lst more end
85.236 handle TUNIFY => [("",T)]
85.237 | LIST _=> [("",T)])
85.238 - | None => [("",T)])
85.239 - | None => [("",T)])
85.240 - | None => [("",T)])
85.241 + | NONE => [("",T)])
85.242 + | NONE => [("",T)])
85.243 + | NONE => [("",T)])
85.244 | _ => [("",T)])
85.245
85.246 val (flds,(_,moreT)) = split_last (field_lst T);
85.247 @@ -843,10 +843,10 @@
85.248 foldl (fn (thms,(n,_)) => (list (Symtab.lookup (extsplit,n)))@thms)
85.249 ([],dest_recTs T);
85.250 val thms = (case get_splits sg (rec_id (~1) T) of
85.251 - Some (all_thm,_,_,_) =>
85.252 + SOME (all_thm,_,_,_) =>
85.253 all_thm::(case extsplits of [thm] => [] | _ => extsplits)
85.254 (* [thm] is the same as all_thm *)
85.255 - | None => extsplits)
85.256 + | NONE => extsplits)
85.257 in (quick_and_dirty_prove true sg [] prop (fn _ => (simp_tac (simpset addsimps thms) 1)))
85.258 end;
85.259
85.260 @@ -873,53 +873,53 @@
85.261 Simplifier.simproc (Theory.sign_of HOL.thy) "record_simp" ["s (u k r)"]
85.262 (fn sg => fn _ => fn t =>
85.263 (case t of (sel as Const (s, Type (_,[domS,rangeS])))$((upd as Const (u, _)) $ k $ r)=>
85.264 - (case get_selectors sg s of Some () =>
85.265 - (case get_updates sg u of Some u_name =>
85.266 + (case get_selectors sg s of SOME () =>
85.267 + (case get_updates sg u of SOME u_name =>
85.268 let
85.269 fun mk_abs_var x t = (x, fastype_of t);
85.270 val {sel_upd={updates,...},extfields,...} = RecordsData.get_sg sg;
85.271
85.272 fun mk_eq_terms ((upd as Const (u,Type(_,[updT,_]))) $ k $ r) =
85.273 (case (Symtab.lookup (updates,u)) of
85.274 - None => None
85.275 - | Some u_name
85.276 + NONE => NONE
85.277 + | SOME u_name
85.278 => if u_name = s
85.279 then let
85.280 val rv = mk_abs_var "r" r
85.281 val rb = Bound 0
85.282 val kv = mk_abs_var "k" k
85.283 val kb = Bound 1
85.284 - in Some (upd$kb$rb,kb,[kv,rv],true) end
85.285 + in SOME (upd$kb$rb,kb,[kv,rv],true) end
85.286 else if u_name mem (map fst (get_fields extfields rangeS))
85.287 orelse s mem (map fst (get_fields extfields updT))
85.288 - then None
85.289 + then NONE
85.290 else (case mk_eq_terms r of
85.291 - Some (trm,trm',vars,update_s)
85.292 + SOME (trm,trm',vars,update_s)
85.293 => let
85.294 val kv = mk_abs_var "k" k
85.295 val kb = Bound (length vars)
85.296 - in Some (upd$kb$trm,trm',kv::vars,update_s) end
85.297 - | None
85.298 + in SOME (upd$kb$trm,trm',kv::vars,update_s) end
85.299 + | NONE
85.300 => let
85.301 val rv = mk_abs_var "r" r
85.302 val rb = Bound 0
85.303 val kv = mk_abs_var "k" k
85.304 val kb = Bound 1
85.305 - in Some (upd$kb$rb,rb,[kv,rv],false) end))
85.306 - | mk_eq_terms r = None
85.307 + in SOME (upd$kb$rb,rb,[kv,rv],false) end))
85.308 + | mk_eq_terms r = NONE
85.309 in
85.310 (case mk_eq_terms (upd$k$r) of
85.311 - Some (trm,trm',vars,update_s)
85.312 + SOME (trm,trm',vars,update_s)
85.313 => if update_s
85.314 - then Some (prove_split_simp sg domS
85.315 + then SOME (prove_split_simp sg domS
85.316 (list_all(vars,(Logic.mk_equals (sel$trm,trm')))))
85.317 - else Some (prove_split_simp sg domS
85.318 + else SOME (prove_split_simp sg domS
85.319 (list_all(vars,(Logic.mk_equals (sel$trm,sel$trm')))))
85.320 - | None => None)
85.321 + | NONE => NONE)
85.322 end
85.323 - | None => None)
85.324 - | None => None)
85.325 - | _ => None));
85.326 + | NONE => NONE)
85.327 + | NONE => NONE)
85.328 + | _ => NONE));
85.329
85.330 (* record_upd_simproc *)
85.331 (* simplify multiple updates:
85.332 @@ -953,9 +953,9 @@
85.333
85.334 fun is_upd_same (sprout,skeleton) u ((sel as Const (s,_))$r) =
85.335 if (unsuffix updateN u) = s andalso (seed s sprout) = r
85.336 - then Some (sel,seed s skeleton)
85.337 - else None
85.338 - | is_upd_same _ _ _ = None
85.339 + then SOME (sel,seed s skeleton)
85.340 + else NONE
85.341 + | is_upd_same _ _ _ = NONE
85.342
85.343 fun init_seed r = ((r,Bound 0), [mk_abs_var "r" r]);
85.344
85.345 @@ -995,22 +995,22 @@
85.346 (case rest (Symtab.update ((u,()),already)) r of
85.347 Init ((sprout,skel),vars) =>
85.348 (case is_upd_same (sprout,skel) u k of
85.349 - Some (sel,skel') =>
85.350 + SOME (sel,skel') =>
85.351 let
85.352 val (sprout',vars') = grow u uT k vars (sprout,skel);
85.353 in Inter(upd$(sel$skel')$skel,skel,vars',sprout') end
85.354 - | None =>
85.355 + | NONE =>
85.356 let
85.357 val kv = mk_abs_var (sel_name u) k;
85.358 val kb = Bound (length vars);
85.359 in Init ((upd$k$sprout,upd$kb$skel),kv::vars) end)
85.360 | Inter (trm,trm',vars,sprout) =>
85.361 (case is_upd_same sprout u k of
85.362 - Some (sel,skel) =>
85.363 + SOME (sel,skel) =>
85.364 let
85.365 val (sprout',vars') = grow u uT k vars sprout
85.366 in Inter(upd$(sel$skel)$trm,trm',vars',sprout') end
85.367 - | None =>
85.368 + | NONE =>
85.369 let
85.370 val kv = mk_abs_var (sel_name u) k
85.371 val kb = Bound (length vars)
85.372 @@ -1022,11 +1022,11 @@
85.373
85.374 in (case mk_updterm updates Symtab.empty t of
85.375 Inter (trm,trm',vars,_)
85.376 - => Some (prove_split_simp sg T
85.377 + => SOME (prove_split_simp sg T
85.378 (list_all(vars,(Logic.mk_equals (trm,trm')))))
85.379 - | _ => None)
85.380 + | _ => NONE)
85.381 end
85.382 - | _ => None));
85.383 + | _ => NONE));
85.384 end
85.385
85.386 (* record_eq_simproc *)
85.387 @@ -1047,11 +1047,11 @@
85.388 (fn sg => fn _ => fn t =>
85.389 (case t of Const ("op =", Type (_, [T, _])) $ _ $ _ =>
85.390 (case rec_id (~1) T of
85.391 - "" => None
85.392 + "" => NONE
85.393 | name => (case get_equalities sg name of
85.394 - None => None
85.395 - | Some thm => Some (thm RS Eq_TrueI)))
85.396 - | _ => None));
85.397 + NONE => NONE
85.398 + | SOME thm => SOME (thm RS Eq_TrueI)))
85.399 + | _ => NONE));
85.400
85.401 (* record_split_simproc *)
85.402 (* splits quantified occurrences of records, for which P holds. P can peek on the
85.403 @@ -1066,22 +1066,22 @@
85.404 (case t of (Const (quantifier, Type (_, [Type (_, [T, _]), _])))$trm =>
85.405 if quantifier = "All" orelse quantifier = "all" orelse quantifier = "Ex"
85.406 then (case rec_id (~1) T of
85.407 - "" => None
85.408 + "" => NONE
85.409 | name
85.410 => let val split = P t
85.411 in if split <> 0 then
85.412 (case get_splits sg (rec_id split T) of
85.413 - None => None
85.414 - | Some (all_thm, All_thm, Ex_thm,_)
85.415 - => Some (case quantifier of
85.416 + NONE => NONE
85.417 + | SOME (all_thm, All_thm, Ex_thm,_)
85.418 + => SOME (case quantifier of
85.419 "all" => all_thm
85.420 | "All" => All_thm RS HOL.eq_reflection
85.421 | "Ex" => Ex_thm RS HOL.eq_reflection
85.422 | _ => error "record_split_simproc"))
85.423 - else None
85.424 + else NONE
85.425 end)
85.426 - else None
85.427 - | _ => None))
85.428 + else NONE
85.429 + | _ => NONE))
85.430
85.431 val record_ex_sel_eq_simproc =
85.432 Simplifier.simproc (Theory.sign_of HOL.thy) "record_ex_sel_eq_simproc" ["Ex t"]
85.433 @@ -1092,14 +1092,14 @@
85.434 addsimprocs [record_split_simproc (K ~1)]) 1)));
85.435
85.436 fun mkeq (lr,Teq,(sel,Tsel),x) i =
85.437 - (case get_selectors sg sel of Some () =>
85.438 + (case get_selectors sg sel of SOME () =>
85.439 let val x' = if not (loose_bvar1 (x,0))
85.440 then Free ("x" ^ string_of_int i, range_type Tsel)
85.441 else raise TERM ("",[x]);
85.442 val sel' = Const (sel,Tsel)$Bound 0;
85.443 val (l,r) = if lr then (sel',x') else (x',sel');
85.444 in Const ("op =",Teq)$l$r end
85.445 - | None => raise TERM ("",[Const (sel,Tsel)]));
85.446 + | NONE => raise TERM ("",[Const (sel,Tsel)]));
85.447
85.448 fun dest_sel_eq (Const ("op =",Teq)$(Const (sel,Tsel)$Bound 0)$X) =
85.449 (true,Teq,(sel,Tsel),X)
85.450 @@ -1114,9 +1114,9 @@
85.451 val prop = list_all ([("r",T)],
85.452 Logic.mk_equals (Const ("Ex",Tex)$Abs(s,T,eq),
85.453 HOLogic.true_const));
85.454 - in Some (prove prop) end
85.455 - handle TERM _ => None
85.456 - | _ => None)
85.457 + in SOME (prove prop) end
85.458 + handle TERM _ => NONE
85.459 + | _ => NONE)
85.460 end)
85.461
85.462
85.463 @@ -1161,16 +1161,16 @@
85.464
85.465 fun split_free_tac P i (free as Free (n,T)) =
85.466 (case rec_id (~1) T of
85.467 - "" => None
85.468 + "" => NONE
85.469 | name => let val split = P free
85.470 in if split <> 0 then
85.471 (case get_splits sg (rec_id split T) of
85.472 - None => None
85.473 - | Some (_,_,_,induct_thm)
85.474 - => Some (mk_split_free_tac free induct_thm i))
85.475 - else None
85.476 + NONE => NONE
85.477 + | SOME (_,_,_,induct_thm)
85.478 + => SOME (mk_split_free_tac free induct_thm i))
85.479 + else NONE
85.480 end)
85.481 - | split_free_tac _ _ _ = None;
85.482 + | split_free_tac _ _ _ = NONE;
85.483
85.484 val split_frees_tacs = mapfilter (split_free_tac P i) frees;
85.485
85.486 @@ -1217,14 +1217,14 @@
85.487
85.488 (*note: read_raw_typ avoids expanding type abbreviations*)
85.489 fun read_raw_parent sign s =
85.490 - (case Sign.read_raw_typ (sign, K None) s handle TYPE (msg, _, _) => error msg of
85.491 + (case Sign.read_raw_typ (sign, K NONE) s handle TYPE (msg, _, _) => error msg of
85.492 Type (name, Ts) => (Ts, name)
85.493 | _ => error ("Bad parent record specification: " ^ quote s));
85.494
85.495 fun read_typ sign (env, s) =
85.496 let
85.497 fun def_sort (x, ~1) = assoc (env, x)
85.498 - | def_sort _ = None;
85.499 + | def_sort _ = NONE;
85.500 val T = Type.no_tvars (Sign.read_typ (sign, def_sort) s) handle TYPE (msg, _, _) => error msg;
85.501 in (Term.add_typ_tfrees (T, env), T) end;
85.502
85.503 @@ -1264,8 +1264,8 @@
85.504 | [x] => (head_of x, false));
85.505 val rule'' = cterm_instantiate (map (pairself cert) (case (rev params) of
85.506 [] => (case assoc (map dest_Free (term_frees (prop_of st)), s) of
85.507 - None => sys_error "try_param_tac: no such variable"
85.508 - | Some T => [(P, if ca then concl else lambda (Free (s, T)) concl),
85.509 + NONE => sys_error "try_param_tac: no such variable"
85.510 + | SOME T => [(P, if ca then concl else lambda (Free (s, T)) concl),
85.511 (x, Free (s, T))])
85.512 | (_, T) :: _ => [(P, list_abs (params, if ca then concl
85.513 else incr_boundvars 1 (Abs (s, T, concl)))),
85.514 @@ -1295,11 +1295,11 @@
85.515 let
85.516 val UNIV = HOLogic.mk_UNIV repT;
85.517
85.518 - val (thy',{set_def=Some def, Abs_induct = abs_induct,
85.519 + val (thy',{set_def=SOME def, Abs_induct = abs_induct,
85.520 Abs_inject=abs_inject, Abs_inverse = abs_inverse,...}) =
85.521 thy |> setmp TypedefPackage.quiet_mode true
85.522 - (TypedefPackage.add_typedef_i true None
85.523 - (suffix ext_typeN (Sign.base_name name), alphas, Syntax.NoSyn) UNIV None
85.524 + (TypedefPackage.add_typedef_i true NONE
85.525 + (suffix ext_typeN (Sign.base_name name), alphas, Syntax.NoSyn) UNIV NONE
85.526 (Tactic.rtac UNIV_witness 1))
85.527 val rewrite_rule = Tactic.rewrite_rule [def, rec_UNIV_I, rec_True_simp];
85.528 in (thy',map rewrite_rule [abs_inject, abs_inverse, abs_induct])
85.529 @@ -1557,9 +1557,9 @@
85.530
85.531 fun obj_to_meta_all thm =
85.532 let
85.533 - fun E thm = case (Some (spec OF [thm]) handle THM _ => None) of
85.534 - Some thm' => E thm'
85.535 - | None => thm;
85.536 + fun E thm = case (SOME (spec OF [thm]) handle THM _ => NONE) of
85.537 + SOME thm' => E thm'
85.538 + | NONE => thm;
85.539 val th1 = E thm;
85.540 val th2 = Drule.forall_intr_vars th1;
85.541 in th2 end;
85.542 @@ -2047,8 +2047,8 @@
85.543
85.544 val init_env =
85.545 (case parent of
85.546 - None => []
85.547 - | Some (types, _) => foldr Term.add_typ_tfrees (types, []));
85.548 + NONE => []
85.549 + | SOME (types, _) => foldr Term.add_typ_tfrees (types, []));
85.550
85.551
85.552 (* fields *)
86.1 --- a/src/HOL/Tools/refute.ML Fri Feb 11 18:51:00 2005 +0100
86.2 +++ b/src/HOL/Tools/refute.ML Sun Feb 13 17:15:14 2005 +0100
86.3 @@ -213,8 +213,8 @@
86.4
86.5 fun interpret thy model args t =
86.6 (case get_first (fn (_, f) => f thy model args t) (#interpreters (RefuteData.get thy)) of
86.7 - None => raise REFUTE ("interpret", "unable to interpret term " ^ quote (Sign.string_of_term (sign_of thy) t))
86.8 - | Some x => x);
86.9 + NONE => raise REFUTE ("interpret", "unable to interpret term " ^ quote (Sign.string_of_term (sign_of thy) t))
86.10 + | SOME x => x);
86.11
86.12 (* ------------------------------------------------------------------------- *)
86.13 (* print: tries to convert the constant denoted by the term 't' into a term *)
86.14 @@ -225,8 +225,8 @@
86.15
86.16 fun print thy model t intr assignment =
86.17 (case get_first (fn (_, f) => f thy model t intr assignment) (#printers (RefuteData.get thy)) of
86.18 - None => Const ("<<no printer available>>", fastype_of t)
86.19 - | Some x => x);
86.20 + NONE => Const ("<<no printer available>>", fastype_of t)
86.21 + | SOME x => x);
86.22
86.23 (* ------------------------------------------------------------------------- *)
86.24 (* print_model: turns the model into a string, using a fixed interpretation *)
86.25 @@ -256,9 +256,9 @@
86.26 space_implode "\n" (mapfilter (fn (t,intr) =>
86.27 (* print constants only if 'show_consts' is true *)
86.28 if (!show_consts) orelse not (is_Const t) then
86.29 - Some (Sign.string_of_term (sign_of thy) t ^ ": " ^ Sign.string_of_term (sign_of thy) (print thy model t intr assignment))
86.30 + SOME (Sign.string_of_term (sign_of thy) t ^ ": " ^ Sign.string_of_term (sign_of thy) (print thy model t intr assignment))
86.31 else
86.32 - None) terms) ^ "\n"
86.33 + NONE) terms) ^ "\n"
86.34 in
86.35 typs_msg ^ show_consts_msg ^ terms_msg
86.36 end;
86.37 @@ -275,8 +275,8 @@
86.38 val {interpreters, printers, parameters} = RefuteData.get thy
86.39 in
86.40 case assoc (interpreters, name) of
86.41 - None => RefuteData.put {interpreters = (name, f) :: interpreters, printers = printers, parameters = parameters} thy
86.42 - | Some _ => error ("Interpreter " ^ name ^ " already declared")
86.43 + NONE => RefuteData.put {interpreters = (name, f) :: interpreters, printers = printers, parameters = parameters} thy
86.44 + | SOME _ => error ("Interpreter " ^ name ^ " already declared")
86.45 end;
86.46
86.47 (* string -> (theory -> model -> Term.term -> interpretation -> (int -> bool) -> Term.term option) -> theory -> theory *)
86.48 @@ -286,8 +286,8 @@
86.49 val {interpreters, printers, parameters} = RefuteData.get thy
86.50 in
86.51 case assoc (printers, name) of
86.52 - None => RefuteData.put {interpreters = interpreters, printers = (name, f) :: printers, parameters = parameters} thy
86.53 - | Some _ => error ("Printer " ^ name ^ " already declared")
86.54 + NONE => RefuteData.put {interpreters = interpreters, printers = (name, f) :: printers, parameters = parameters} thy
86.55 + | SOME _ => error ("Printer " ^ name ^ " already declared")
86.56 end;
86.57
86.58 (* ------------------------------------------------------------------------- *)
86.59 @@ -302,9 +302,9 @@
86.60 val {interpreters, printers, parameters} = RefuteData.get thy
86.61 in
86.62 case Symtab.lookup (parameters, name) of
86.63 - None => RefuteData.put
86.64 + NONE => RefuteData.put
86.65 {interpreters = interpreters, printers = printers, parameters = Symtab.extend (parameters, [(name, value)])} thy
86.66 - | Some _ => RefuteData.put
86.67 + | SOME _ => RefuteData.put
86.68 {interpreters = interpreters, printers = printers, parameters = Symtab.update ((name, value), parameters)} thy
86.69 end;
86.70
86.71 @@ -339,15 +339,15 @@
86.72 (* (string * string) list * string -> int *)
86.73 fun read_int (parms, name) =
86.74 case assoc_string (parms, name) of
86.75 - Some s => (case Int.fromString s of
86.76 + SOME s => (case Int.fromString s of
86.77 SOME i => i
86.78 | NONE => error ("parameter " ^ quote name ^ " (value is " ^ quote s ^ ") must be an integer value"))
86.79 - | None => error ("parameter " ^ quote name ^ " must be assigned a value")
86.80 + | NONE => error ("parameter " ^ quote name ^ " must be assigned a value")
86.81 (* (string * string) list * string -> string *)
86.82 fun read_string (parms, name) =
86.83 case assoc_string (parms, name) of
86.84 - Some s => s
86.85 - | None => error ("parameter " ^ quote name ^ " must be assigned a value")
86.86 + SOME s => s
86.87 + | NONE => error ("parameter " ^ quote name ^ " must be assigned a value")
86.88 (* (string * string) list *)
86.89 val allparams = override @ (get_default_params thy) (* 'override' first, defaults last *)
86.90 (* int *)
86.91 @@ -363,7 +363,7 @@
86.92 (* whose name is one of the other parameters (e.g. 'maxvars') *)
86.93 (* (string * int) list *)
86.94 val sizes = mapfilter
86.95 - (fn (name,value) => (case Int.fromString value of SOME i => Some (name, i) | NONE => None))
86.96 + (fn (name,value) => (case Int.fromString value of SOME i => SOME (name, i) | NONE => NONE))
86.97 (filter (fn (name,_) => name<>"minsize" andalso name<>"maxsize" andalso name<>"maxvars" andalso name<>"maxtime" andalso name<>"satsolver")
86.98 allparams)
86.99 in
86.100 @@ -431,27 +431,27 @@
86.101 let
86.102 fun find_typeSubs (Const (s', T')) =
86.103 (if s=s' then
86.104 - Some (Type.typ_match (Sign.tsig_of (sign_of thy)) (Vartab.empty, (T', T)))
86.105 + SOME (Type.typ_match (Sign.tsig_of (sign_of thy)) (Vartab.empty, (T', T)))
86.106 else
86.107 - None
86.108 - handle Type.TYPE_MATCH => None)
86.109 - | find_typeSubs (Free _) = None
86.110 - | find_typeSubs (Var _) = None
86.111 - | find_typeSubs (Bound _) = None
86.112 + NONE
86.113 + handle Type.TYPE_MATCH => NONE)
86.114 + | find_typeSubs (Free _) = NONE
86.115 + | find_typeSubs (Var _) = NONE
86.116 + | find_typeSubs (Bound _) = NONE
86.117 | find_typeSubs (Abs (_, _, body)) = find_typeSubs body
86.118 - | find_typeSubs (t1 $ t2) = (case find_typeSubs t1 of Some x => Some x | None => find_typeSubs t2)
86.119 + | find_typeSubs (t1 $ t2) = (case find_typeSubs t1 of SOME x => SOME x | NONE => find_typeSubs t2)
86.120 val typeSubs = (case find_typeSubs t of
86.121 - Some x => x
86.122 - | None => raise REFUTE ("collect_axioms", "no type instantiation found for " ^ quote s ^ " in " ^ Sign.string_of_term (sign_of thy) t))
86.123 + SOME x => x
86.124 + | NONE => raise REFUTE ("collect_axioms", "no type instantiation found for " ^ quote s ^ " in " ^ Sign.string_of_term (sign_of thy) t))
86.125 in
86.126 map_term_types
86.127 (map_type_tvar
86.128 (fn (v,_) =>
86.129 case Vartab.lookup (typeSubs, v) of
86.130 - None =>
86.131 + NONE =>
86.132 (* schematic type variable not instantiated *)
86.133 raise REFUTE ("collect_axioms", "term " ^ Sign.string_of_term (sign_of thy) t ^ " still has a polymorphic type (after instantiating type of " ^ quote s ^ ")")
86.134 - | Some typ =>
86.135 + | SOME typ =>
86.136 typ))
86.137 t
86.138 end
86.139 @@ -462,10 +462,10 @@
86.140 map_term_types (map_type_tvar
86.141 (fn (v,_) =>
86.142 case Vartab.lookup (typeSubs, v) of
86.143 - None =>
86.144 + NONE =>
86.145 (* schematic type variable not instantiated *)
86.146 raise ERROR
86.147 - | Some typ =>
86.148 + | SOME typ =>
86.149 typ)) t
86.150 (* Term.term list * Term.typ -> Term.term list *)
86.151 fun collect_type_axioms (axs, T) =
86.152 @@ -479,30 +479,30 @@
86.153 (* look up the definition of a type, as created by "typedef" *)
86.154 (* (string * Term.term) list -> (string * Term.term) option *)
86.155 fun get_typedefn [] =
86.156 - None
86.157 + NONE
86.158 | get_typedefn ((axname,ax)::axms) =
86.159 (let
86.160 (* Term.term -> Term.typ option *)
86.161 fun type_of_type_definition (Const (s', T')) =
86.162 if s'="Typedef.type_definition" then
86.163 - Some T'
86.164 + SOME T'
86.165 else
86.166 - None
86.167 - | type_of_type_definition (Free _) = None
86.168 - | type_of_type_definition (Var _) = None
86.169 - | type_of_type_definition (Bound _) = None
86.170 + NONE
86.171 + | type_of_type_definition (Free _) = NONE
86.172 + | type_of_type_definition (Var _) = NONE
86.173 + | type_of_type_definition (Bound _) = NONE
86.174 | type_of_type_definition (Abs (_, _, body)) = type_of_type_definition body
86.175 - | type_of_type_definition (t1 $ t2) = (case type_of_type_definition t1 of Some x => Some x | None => type_of_type_definition t2)
86.176 + | type_of_type_definition (t1 $ t2) = (case type_of_type_definition t1 of SOME x => SOME x | NONE => type_of_type_definition t2)
86.177 in
86.178 case type_of_type_definition ax of
86.179 - Some T' =>
86.180 + SOME T' =>
86.181 let
86.182 val T'' = (domain_type o domain_type) T'
86.183 val typeSubs = Type.typ_match (Sign.tsig_of (sign_of thy)) (Vartab.empty, (T'', T))
86.184 in
86.185 - Some (axname, monomorphic_term typeSubs ax)
86.186 + SOME (axname, monomorphic_term typeSubs ax)
86.187 end
86.188 - | None =>
86.189 + | NONE =>
86.190 get_typedefn axms
86.191 end
86.192 handle ERROR => get_typedefn axms
86.193 @@ -510,19 +510,19 @@
86.194 | Type.TYPE_MATCH => get_typedefn axms)
86.195 in
86.196 case DatatypePackage.datatype_info thy s of
86.197 - Some info => (* inductive datatype *)
86.198 + SOME info => (* inductive datatype *)
86.199 (* only collect relevant type axioms for the argument types *)
86.200 foldl collect_type_axioms (axs, Ts)
86.201 - | None =>
86.202 + | NONE =>
86.203 (case get_typedefn axioms of
86.204 - Some (axname, ax) =>
86.205 + SOME (axname, ax) =>
86.206 if mem_term (ax, axs) then
86.207 (* collect relevant type axioms for the argument types *)
86.208 foldl collect_type_axioms (axs, Ts)
86.209 else
86.210 (immediate_output (" " ^ axname);
86.211 collect_term_axioms (ax :: axs, ax))
86.212 - | None =>
86.213 + | NONE =>
86.214 (* at least collect relevant type axioms for the argument types *)
86.215 foldl collect_type_axioms (axs, Ts))
86.216 end
86.217 @@ -579,7 +579,7 @@
86.218 (* look up the definition of a constant, as created by "constdefs" *)
86.219 (* string -> Term.typ -> (string * Term.term) list -> (string * Term.term) option *)
86.220 fun get_defn [] =
86.221 - None
86.222 + NONE
86.223 | get_defn ((axname,ax)::axms) =
86.224 (let
86.225 val (lhs, _) = Logic.dest_equals ax (* equations only *)
86.226 @@ -590,7 +590,7 @@
86.227 let
86.228 val typeSubs = Type.typ_match (Sign.tsig_of (sign_of thy)) (Vartab.empty, (T', T))
86.229 in
86.230 - Some (axname, monomorphic_term typeSubs ax)
86.231 + SOME (axname, monomorphic_term typeSubs ax)
86.232 end
86.233 else
86.234 get_defn axms
86.235 @@ -603,7 +603,7 @@
86.236 (case body_type T of
86.237 Type (s', _) =>
86.238 (case DatatypePackage.constrs_of thy s' of
86.239 - Some constrs =>
86.240 + SOME constrs =>
86.241 Library.exists (fn c =>
86.242 (case c of
86.243 Const (cname, ctype) =>
86.244 @@ -611,7 +611,7 @@
86.245 | _ =>
86.246 raise REFUTE ("collect_axioms", "IDT constructor is not a constant")))
86.247 constrs
86.248 - | None =>
86.249 + | NONE =>
86.250 false)
86.251 | _ =>
86.252 false)
86.253 @@ -622,8 +622,8 @@
86.254 ((case last_elem (binder_types T) of
86.255 Type (s', _) =>
86.256 (case DatatypePackage.datatype_info thy s' of
86.257 - Some info => s mem (#rec_names info)
86.258 - | None => false) (* not an inductive datatype *)
86.259 + SOME info => s mem (#rec_names info)
86.260 + | NONE => false) (* not an inductive datatype *)
86.261 | _ => (* a (free or schematic) type variable *)
86.262 false)
86.263 handle LIST "last_elem" => false) (* not even a function type *)
86.264 @@ -641,14 +641,14 @@
86.265 collect_type_axioms (axs, T)
86.266 ) else
86.267 (case get_defn axioms of
86.268 - Some (axname, ax) =>
86.269 + SOME (axname, ax) =>
86.270 if mem_term (ax, axs) then
86.271 (* collect relevant type axioms *)
86.272 collect_type_axioms (axs, T)
86.273 else
86.274 (immediate_output (" " ^ axname);
86.275 collect_term_axioms (ax :: axs, ax))
86.276 - | None =>
86.277 + | NONE =>
86.278 (* collect relevant type axioms *)
86.279 collect_type_axioms (axs, T))
86.280 end
86.281 @@ -698,7 +698,7 @@
86.282 | Type ("set", [T1]) => collect_types (T1, acc)
86.283 | Type (s, Ts) =>
86.284 (case DatatypePackage.datatype_info thy s of
86.285 - Some info => (* inductive datatype *)
86.286 + SOME info => (* inductive datatype *)
86.287 let
86.288 val index = #index info
86.289 val descr = #descr info
86.290 @@ -723,7 +723,7 @@
86.291 in
86.292 acc_constrs
86.293 end
86.294 - | None => (* not an inductive datatype, e.g. defined via "typedef" or "typedecl" *)
86.295 + | NONE => (* not an inductive datatype, e.g. defined via "typedef" or "typedecl" *)
86.296 T ins (foldr collect_types (Ts, acc)))
86.297 | TFree _ => T ins acc
86.298 | TVar _ => T ins acc)
86.299 @@ -756,8 +756,8 @@
86.300 let
86.301 fun size_of_typ T =
86.302 case assoc (sizes, string_of_typ T) of
86.303 - Some n => n
86.304 - | None => minsize
86.305 + SOME n => n
86.306 + | NONE => minsize
86.307 in
86.308 map (fn T => (T, size_of_typ T)) xs
86.309 end;
86.310 @@ -775,15 +775,15 @@
86.311 let
86.312 (* int -> int list -> int list option *)
86.313 fun add1 _ [] =
86.314 - None (* overflow *)
86.315 + NONE (* overflow *)
86.316 | add1 max (x::xs) =
86.317 if x<max orelse max<0 then
86.318 - Some ((x+1)::xs) (* add 1 to the head *)
86.319 + SOME ((x+1)::xs) (* add 1 to the head *)
86.320 else
86.321 apsome (fn xs' => 0 :: xs') (add1 max xs) (* carry-over *)
86.322 (* int -> int list * int list -> int list option *)
86.323 fun shift _ (_, []) =
86.324 - None
86.325 + NONE
86.326 | shift max (zeros, x::xs) =
86.327 if x=0 then
86.328 shift max (0::zeros, xs)
86.329 @@ -794,9 +794,9 @@
86.330 (* int -> int -> int -> int list option *)
86.331 fun make_first 0 sum _ =
86.332 if sum=0 then
86.333 - Some []
86.334 + SOME []
86.335 else
86.336 - None
86.337 + NONE
86.338 | make_first len sum max =
86.339 if sum<=max orelse max<0 then
86.340 apsome (fn xs' => sum :: xs') (make_first (len-1) 0 max)
86.341 @@ -807,29 +807,29 @@
86.342 (* int -> int list -> int list option *)
86.343 fun next max xs =
86.344 (case shift max ([], xs) of
86.345 - Some xs' =>
86.346 - Some xs'
86.347 - | None =>
86.348 + SOME xs' =>
86.349 + SOME xs'
86.350 + | NONE =>
86.351 let
86.352 val (len, sum) = foldl (fn ((l, s), x) => (l+1, s+x)) ((0, 0), xs)
86.353 in
86.354 make_first len (sum+1) max (* increment 'sum' by 1 *)
86.355 end)
86.356 (* only consider those types for which the size is not fixed *)
86.357 - val mutables = filter (fn (T, _) => assoc (sizes, string_of_typ T) = None) xs
86.358 + val mutables = filter (fn (T, _) => assoc (sizes, string_of_typ T) = NONE) xs
86.359 (* subtract 'minsize' from every size (will be added again at the end) *)
86.360 val diffs = map (fn (_, n) => n-minsize) mutables
86.361 in
86.362 case next (maxsize-minsize) diffs of
86.363 - Some diffs' =>
86.364 + SOME diffs' =>
86.365 (* merge with those types for which the size is fixed *)
86.366 - Some (snd (foldl_map (fn (ds, (T, _)) =>
86.367 + SOME (snd (foldl_map (fn (ds, (T, _)) =>
86.368 case assoc (sizes, string_of_typ T) of
86.369 - Some n => (ds, (T, n)) (* return the fixed size *)
86.370 - | None => (tl ds, (T, minsize + (hd ds)))) (* consume the head of 'ds', add 'minsize' *)
86.371 + SOME n => (ds, (T, n)) (* return the fixed size *)
86.372 + | NONE => (tl ds, (T, minsize + (hd ds)))) (* consume the head of 'ds', add 'minsize' *)
86.373 (diffs', xs)))
86.374 - | None =>
86.375 - None
86.376 + | NONE =>
86.377 + NONE
86.378 end;
86.379
86.380 (* ------------------------------------------------------------------------- *)
86.381 @@ -901,12 +901,12 @@
86.382 immediate_output " invoking SAT solver...";
86.383 (case SatSolver.invoke_solver satsolver fm of
86.384 SatSolver.SATISFIABLE assignment =>
86.385 - writeln ("\n*** Model found: ***\n" ^ print_model thy model (fn i => case assignment i of Some b => b | None => true))
86.386 + writeln ("\n*** Model found: ***\n" ^ print_model thy model (fn i => case assignment i of SOME b => b | NONE => true))
86.387 | _ => (* SatSolver.UNSATISFIABLE, SatSolver.UNKNOWN *)
86.388 (immediate_output " no model found.\n";
86.389 case next_universe universe sizes minsize maxsize of
86.390 - Some universe' => find_model_loop universe'
86.391 - | None => writeln "Search terminated, no larger universe within the given limits."))
86.392 + SOME universe' => find_model_loop universe'
86.393 + | NONE => writeln "Search terminated, no larger universe within the given limits."))
86.394 handle SatSolver.NOT_CONFIGURED =>
86.395 error ("SAT solver " ^ quote satsolver ^ " is not configured.")
86.396 end handle MAXVARS_EXCEEDED =>
86.397 @@ -1207,7 +1207,7 @@
86.398 val wf = (if size=1 then True else if size=2 then True else exactly_one_true fms)
86.399 in
86.400 (* extend the model, increase 'next_idx', add well-formedness condition *)
86.401 - Some (intr, (typs, (t, intr)::terms), {maxvars = maxvars, next_idx = next, bounds = bounds, wellformed = SAnd (wellformed, wf)})
86.402 + SOME (intr, (typs, (t, intr)::terms), {maxvars = maxvars, next_idx = next, bounds = bounds, wellformed = SAnd (wellformed, wf)})
86.403 end
86.404 in
86.405 case T of
86.406 @@ -1235,7 +1235,7 @@
86.407 val intr = Node copies
86.408 in
86.409 (* extend the model, increase 'next_idx', add well-formedness condition *)
86.410 - Some (intr, (typs, (t, intr)::terms), {maxvars = maxvars, next_idx = next, bounds = bounds, wellformed = SAnd (wellformed, wf)})
86.411 + SOME (intr, (typs, (t, intr)::terms), {maxvars = maxvars, next_idx = next, bounds = bounds, wellformed = SAnd (wellformed, wf)})
86.412 end
86.413 | Type _ => interpret_groundtype ()
86.414 | TFree _ => interpret_groundtype ()
86.415 @@ -1243,10 +1243,10 @@
86.416 end
86.417 in
86.418 case assoc (terms, t) of
86.419 - Some intr =>
86.420 + SOME intr =>
86.421 (* return an existing interpretation *)
86.422 - Some (intr, model, args)
86.423 - | None =>
86.424 + SOME (intr, model, args)
86.425 + | NONE =>
86.426 (case t of
86.427 Const (_, T) =>
86.428 interpret_groundterm T
86.429 @@ -1255,7 +1255,7 @@
86.430 | Var (_, T) =>
86.431 interpret_groundterm T
86.432 | Bound i =>
86.433 - Some (nth_elem (i, #bounds args), model, args)
86.434 + SOME (nth_elem (i, #bounds args), model, args)
86.435 | Abs (x, T, body) =>
86.436 let
86.437 (* create all constants of type 'T' *)
86.438 @@ -1273,7 +1273,7 @@
86.439 end)
86.440 ((model, args), constants)
86.441 in
86.442 - Some (Node bodies, model', args')
86.443 + SOME (Node bodies, model', args')
86.444 end
86.445 | t1 $ t2 =>
86.446 let
86.447 @@ -1321,7 +1321,7 @@
86.448 val (intr1, model1, args1) = interpret thy model args t1
86.449 val (intr2, model2, args2) = interpret thy model1 args1 t2
86.450 in
86.451 - Some (interpretation_apply (intr1,intr2), model2, args2)
86.452 + SOME (interpretation_apply (intr1,intr2), model2, args2)
86.453 end)
86.454 end;
86.455
86.456 @@ -1339,7 +1339,7 @@
86.457 val fmTrue = PropLogic.all (map toTrue xs)
86.458 val fmFalse = PropLogic.exists (map toFalse xs)
86.459 in
86.460 - Some (Leaf [fmTrue, fmFalse], m, a)
86.461 + SOME (Leaf [fmTrue, fmFalse], m, a)
86.462 end
86.463 | _ =>
86.464 raise REFUTE ("Pure_interpreter", "\"all\" is not followed by a function")
86.465 @@ -1349,11 +1349,11 @@
86.466 val (i1, m1, a1) = interpret thy model args t1
86.467 val (i2, m2, a2) = interpret thy m1 a1 t2
86.468 in
86.469 - Some (make_equality (i1, i2), m2, a2)
86.470 + SOME (make_equality (i1, i2), m2, a2)
86.471 end
86.472 | Const ("==>", _) => (* simpler than translating 'Const ("==>", _) $ t1 $ t2' *)
86.473 - Some (Node [Node [TT, FF], Node [TT, TT]], model, args)
86.474 - | _ => None;
86.475 + SOME (Node [Node [TT, FF], Node [TT, TT]], model, args)
86.476 + | _ => NONE;
86.477
86.478 (* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
86.479
86.480 @@ -1366,13 +1366,13 @@
86.481 (* ------------------------------------------------------------------------- *)
86.482 case t of
86.483 Const ("Trueprop", _) =>
86.484 - Some (Node [TT, FF], model, args)
86.485 + SOME (Node [TT, FF], model, args)
86.486 | Const ("Not", _) =>
86.487 - Some (Node [FF, TT], model, args)
86.488 + SOME (Node [FF, TT], model, args)
86.489 | Const ("True", _) => (* redundant, since 'True' is also an IDT constructor *)
86.490 - Some (TT, model, args)
86.491 + SOME (TT, model, args)
86.492 | Const ("False", _) => (* redundant, since 'False' is also an IDT constructor *)
86.493 - Some (FF, model, args)
86.494 + SOME (FF, model, args)
86.495 | Const ("All", _) $ t1 =>
86.496 (* if "All" occurs without an argument (i.e. as argument to a higher-order *)
86.497 (* function or predicate), it is handled by the 'stlc_interpreter' (i.e. *)
86.498 @@ -1386,7 +1386,7 @@
86.499 val fmTrue = PropLogic.all (map toTrue xs)
86.500 val fmFalse = PropLogic.exists (map toFalse xs)
86.501 in
86.502 - Some (Leaf [fmTrue, fmFalse], m, a)
86.503 + SOME (Leaf [fmTrue, fmFalse], m, a)
86.504 end
86.505 | _ =>
86.506 raise REFUTE ("HOLogic_interpreter", "\"All\" is followed by a non-function")
86.507 @@ -1404,7 +1404,7 @@
86.508 val fmTrue = PropLogic.exists (map toTrue xs)
86.509 val fmFalse = PropLogic.all (map toFalse xs)
86.510 in
86.511 - Some (Leaf [fmTrue, fmFalse], m, a)
86.512 + SOME (Leaf [fmTrue, fmFalse], m, a)
86.513 end
86.514 | _ =>
86.515 raise REFUTE ("HOLogic_interpreter", "\"Ex\" is followed by a non-function")
86.516 @@ -1414,19 +1414,19 @@
86.517 val (i1, m1, a1) = interpret thy model args t1
86.518 val (i2, m2, a2) = interpret thy m1 a1 t2
86.519 in
86.520 - Some (make_equality (i1, i2), m2, a2)
86.521 + SOME (make_equality (i1, i2), m2, a2)
86.522 end
86.523 | Const ("op =", _) $ t1 =>
86.524 - Some (interpret thy model args (eta_expand t 1))
86.525 + SOME (interpret thy model args (eta_expand t 1))
86.526 | Const ("op =", _) =>
86.527 - Some (interpret thy model args (eta_expand t 2))
86.528 + SOME (interpret thy model args (eta_expand t 2))
86.529 | Const ("op &", _) =>
86.530 - Some (Node [Node [TT, FF], Node [FF, FF]], model, args)
86.531 + SOME (Node [Node [TT, FF], Node [FF, FF]], model, args)
86.532 | Const ("op |", _) =>
86.533 - Some (Node [Node [TT, TT], Node [TT, FF]], model, args)
86.534 + SOME (Node [Node [TT, TT], Node [TT, FF]], model, args)
86.535 | Const ("op -->", _) =>
86.536 - Some (Node [Node [TT, FF], Node [TT, TT]], model, args)
86.537 - | _ => None;
86.538 + SOME (Node [Node [TT, FF], Node [TT, TT]], model, args)
86.539 + | _ => NONE;
86.540
86.541 (* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
86.542
86.543 @@ -1436,42 +1436,42 @@
86.544 val (typs, terms) = model
86.545 in
86.546 case assoc (terms, t) of
86.547 - Some intr =>
86.548 + SOME intr =>
86.549 (* return an existing interpretation *)
86.550 - Some (intr, model, args)
86.551 - | None =>
86.552 + SOME (intr, model, args)
86.553 + | NONE =>
86.554 (case t of
86.555 Free (x, Type ("set", [T])) =>
86.556 let
86.557 val (intr, _, args') = interpret thy (typs, []) args (Free (x, T --> HOLogic.boolT))
86.558 in
86.559 - Some (intr, (typs, (t, intr)::terms), args')
86.560 + SOME (intr, (typs, (t, intr)::terms), args')
86.561 end
86.562 | Var ((x,i), Type ("set", [T])) =>
86.563 let
86.564 val (intr, _, args') = interpret thy (typs, []) args (Var ((x,i), T --> HOLogic.boolT))
86.565 in
86.566 - Some (intr, (typs, (t, intr)::terms), args')
86.567 + SOME (intr, (typs, (t, intr)::terms), args')
86.568 end
86.569 | Const (s, Type ("set", [T])) =>
86.570 let
86.571 val (intr, _, args') = interpret thy (typs, []) args (Const (s, T --> HOLogic.boolT))
86.572 in
86.573 - Some (intr, (typs, (t, intr)::terms), args')
86.574 + SOME (intr, (typs, (t, intr)::terms), args')
86.575 end
86.576 (* 'Collect' == identity *)
86.577 | Const ("Collect", _) $ t1 =>
86.578 - Some (interpret thy model args t1)
86.579 + SOME (interpret thy model args t1)
86.580 | Const ("Collect", _) =>
86.581 - Some (interpret thy model args (eta_expand t 1))
86.582 + SOME (interpret thy model args (eta_expand t 1))
86.583 (* 'op :' == application *)
86.584 | Const ("op :", _) $ t1 $ t2 =>
86.585 - Some (interpret thy model args (t2 $ t1))
86.586 + SOME (interpret thy model args (t2 $ t1))
86.587 | Const ("op :", _) $ t1 =>
86.588 - Some (interpret thy model args (eta_expand t 1))
86.589 + SOME (interpret thy model args (eta_expand t 1))
86.590 | Const ("op :", _) =>
86.591 - Some (interpret thy model args (eta_expand t 2))
86.592 - | _ => None)
86.593 + SOME (interpret thy model args (eta_expand t 2))
86.594 + | _ => NONE)
86.595 end;
86.596
86.597 (* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
86.598 @@ -1482,15 +1482,15 @@
86.599 (* Term.typ -> (interpretation * model * arguments) option *)
86.600 fun interpret_variable (Type (s, Ts)) =
86.601 (case DatatypePackage.datatype_info thy s of
86.602 - Some info => (* inductive datatype *)
86.603 + SOME info => (* inductive datatype *)
86.604 let
86.605 val (typs, terms) = model
86.606 (* int option -- only recursive IDTs have an associated depth *)
86.607 val depth = assoc (typs, Type (s, Ts))
86.608 in
86.609 - if depth = (Some 0) then (* termination condition to avoid infinite recursion *)
86.610 + if depth = (SOME 0) then (* termination condition to avoid infinite recursion *)
86.611 (* return a leaf of size 0 *)
86.612 - Some (Leaf [], model, args)
86.613 + SOME (Leaf [], model, args)
86.614 else
86.615 let
86.616 val index = #index info
86.617 @@ -1505,7 +1505,7 @@
86.618 else
86.619 ())
86.620 (* if the model specifies a depth for the current type, decrement it to avoid infinite recursion *)
86.621 - val typs' = (case depth of None => typs | Some n => overwrite (typs, (Type (s, Ts), n-1)))
86.622 + val typs' = (case depth of NONE => typs | SOME n => overwrite (typs, (Type (s, Ts), n-1)))
86.623 (* recursively compute the size of the datatype *)
86.624 val size = size_of_dtyp thy typs' descr typ_assoc constrs
86.625 val next_idx = #next_idx args
86.626 @@ -1525,19 +1525,19 @@
86.627 val wf = (if size=1 then True else if size=2 then True else exactly_one_true fms)
86.628 in
86.629 (* extend the model, increase 'next_idx', add well-formedness condition *)
86.630 - Some (intr, (typs, (t, intr)::terms), {maxvars = #maxvars args, next_idx = next, bounds = #bounds args, wellformed = SAnd (#wellformed args, wf)})
86.631 + SOME (intr, (typs, (t, intr)::terms), {maxvars = #maxvars args, next_idx = next, bounds = #bounds args, wellformed = SAnd (#wellformed args, wf)})
86.632 end
86.633 end
86.634 - | None => (* not an inductive datatype *)
86.635 - None)
86.636 + | NONE => (* not an inductive datatype *)
86.637 + NONE)
86.638 | interpret_variable _ = (* a (free or schematic) type variable *)
86.639 - None
86.640 + NONE
86.641 in
86.642 case assoc (terms, t) of
86.643 - Some intr =>
86.644 + SOME intr =>
86.645 (* return an existing interpretation *)
86.646 - Some (intr, model, args)
86.647 - | None =>
86.648 + SOME (intr, model, args)
86.649 + | NONE =>
86.650 (case t of
86.651 Free (_, T) => interpret_variable T
86.652 | Var (_, T) => interpret_variable T
86.653 @@ -1549,7 +1549,7 @@
86.654 (case body_type T of
86.655 Type (s', Ts') =>
86.656 (case DatatypePackage.datatype_info thy s' of
86.657 - Some info => (* body type is an inductive datatype *)
86.658 + SOME info => (* body type is an inductive datatype *)
86.659 let
86.660 val index = #index info
86.661 val descr = #descr info
86.662 @@ -1570,12 +1570,12 @@
86.663 case constrs2 of
86.664 [] =>
86.665 (* 'Const (s, T)' is not a constructor of this datatype *)
86.666 - None
86.667 + NONE
86.668 | c::cs =>
86.669 let
86.670 (* int option -- only recursive IDTs have an associated depth *)
86.671 val depth = assoc (typs, Type (s', Ts'))
86.672 - val typs' = (case depth of None => typs | Some n => overwrite (typs, (Type (s', Ts'), n-1)))
86.673 + val typs' = (case depth of NONE => typs | SOME n => overwrite (typs, (Type (s', Ts'), n-1)))
86.674 (* constructors before 'Const (s, T)' generate elements of the datatype *)
86.675 val offset = size_of_dtyp thy typs' descr typ_assoc constrs1
86.676 (* 'Const (s, T)' and constructors after it generate elements of the datatype *)
86.677 @@ -1620,19 +1620,19 @@
86.678 (new_offset, Node (intrs @ (replicate (size-size') (make_partial ds))))
86.679 end
86.680 in
86.681 - Some ((snd o make_constr) (offset, snd c), model, args)
86.682 + SOME ((snd o make_constr) (offset, snd c), model, args)
86.683 end
86.684 end
86.685 - | None => (* body type is not an inductive datatype *)
86.686 - None)
86.687 + | NONE => (* body type is not an inductive datatype *)
86.688 + NONE)
86.689 | _ => (* body type is a (free or schematic) type variable *)
86.690 - None)
86.691 + NONE)
86.692 in
86.693 case interpret_constructor () of
86.694 - Some x => Some x
86.695 - | None => interpret_variable T
86.696 + SOME x => SOME x
86.697 + | NONE => interpret_variable T
86.698 end
86.699 - | _ => None)
86.700 + | _ => NONE)
86.701 end;
86.702
86.703 (* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
86.704 @@ -1667,10 +1667,10 @@
86.705 Leaf (replicate size_nat False)
86.706 end
86.707 in
86.708 - Some (Node (map card constants), model, args)
86.709 + SOME (Node (map card constants), model, args)
86.710 end
86.711 | _ =>
86.712 - None;
86.713 + NONE;
86.714
86.715
86.716 (* ------------------------------------------------------------------------- *)
86.717 @@ -1682,10 +1682,10 @@
86.718 fun stlc_printer thy model t intr assignment =
86.719 let
86.720 (* Term.term -> Term.typ option *)
86.721 - fun typeof (Free (_, T)) = Some T
86.722 - | typeof (Var (_, T)) = Some T
86.723 - | typeof (Const (_, T)) = Some T
86.724 - | typeof _ = None
86.725 + fun typeof (Free (_, T)) = SOME T
86.726 + | typeof (Var (_, T)) = SOME T
86.727 + | typeof (Const (_, T)) = SOME T
86.728 + | typeof _ = NONE
86.729 (* string -> string *)
86.730 fun strip_leading_quote s =
86.731 (implode o (fn ss => case ss of [] => [] | x::xs => if x="'" then xs else ss) o explode) s
86.732 @@ -1707,7 +1707,7 @@
86.733 raise REFUTE ("stlc_printer", "interpretation for ground type is not a leaf")
86.734 in
86.735 case typeof t of
86.736 - Some T =>
86.737 + SOME T =>
86.738 (case T of
86.739 Type ("fun", [T1, T2]) =>
86.740 let
86.741 @@ -1731,18 +1731,18 @@
86.742 val HOLogic_empty_set = Const ("{}", HOLogic_setT)
86.743 val HOLogic_insert = Const ("insert", HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
86.744 in
86.745 - Some (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc) (pairs, HOLogic_empty_set))
86.746 + SOME (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc) (pairs, HOLogic_empty_set))
86.747 end
86.748 | Type ("prop", []) =>
86.749 (case index_from_interpretation intr of
86.750 - 0 => Some (HOLogic.mk_Trueprop HOLogic.true_const)
86.751 - | 1 => Some (HOLogic.mk_Trueprop HOLogic.false_const)
86.752 + 0 => SOME (HOLogic.mk_Trueprop HOLogic.true_const)
86.753 + | 1 => SOME (HOLogic.mk_Trueprop HOLogic.false_const)
86.754 | _ => raise REFUTE ("stlc_interpreter", "illegal interpretation for a propositional value"))
86.755 - | Type _ => Some (Const (string_of_typ T ^ string_of_int (index_from_interpretation intr), T))
86.756 - | TFree _ => Some (Const (string_of_typ T ^ string_of_int (index_from_interpretation intr), T))
86.757 - | TVar _ => Some (Const (string_of_typ T ^ string_of_int (index_from_interpretation intr), T)))
86.758 - | None =>
86.759 - None
86.760 + | Type _ => SOME (Const (string_of_typ T ^ string_of_int (index_from_interpretation intr), T))
86.761 + | TFree _ => SOME (Const (string_of_typ T ^ string_of_int (index_from_interpretation intr), T))
86.762 + | TVar _ => SOME (Const (string_of_typ T ^ string_of_int (index_from_interpretation intr), T)))
86.763 + | NONE =>
86.764 + NONE
86.765 end;
86.766
86.767 (* theory -> model -> Term.term -> interpretation -> (int -> bool) -> string option *)
86.768 @@ -1750,13 +1750,13 @@
86.769 fun set_printer thy model t intr assignment =
86.770 let
86.771 (* Term.term -> Term.typ option *)
86.772 - fun typeof (Free (_, T)) = Some T
86.773 - | typeof (Var (_, T)) = Some T
86.774 - | typeof (Const (_, T)) = Some T
86.775 - | typeof _ = None
86.776 + fun typeof (Free (_, T)) = SOME T
86.777 + | typeof (Var (_, T)) = SOME T
86.778 + | typeof (Const (_, T)) = SOME T
86.779 + | typeof _ = NONE
86.780 in
86.781 case typeof t of
86.782 - Some (Type ("set", [T])) =>
86.783 + SOME (Type ("set", [T])) =>
86.784 let
86.785 (* create all constants of type 'T' *)
86.786 val (i, _, _) = interpret thy model {maxvars=0, next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
86.787 @@ -1770,9 +1770,9 @@
86.788 case result of
86.789 Leaf [fmTrue, fmFalse] =>
86.790 if PropLogic.eval assignment fmTrue then
86.791 - Some (print thy model (Free ("dummy", T)) arg assignment)
86.792 + SOME (print thy model (Free ("dummy", T)) arg assignment)
86.793 else if PropLogic.eval assignment fmFalse then
86.794 - None
86.795 + NONE
86.796 else
86.797 raise REFUTE ("set_printer", "illegal interpretation: no value assigned (SAT solver unsound?)")
86.798 | _ =>
86.799 @@ -1784,10 +1784,10 @@
86.800 val HOLogic_empty_set = Const ("{}", HOLogic_setT)
86.801 val HOLogic_insert = Const ("insert", T --> HOLogic_setT --> HOLogic_setT)
86.802 in
86.803 - Some (foldl (fn (acc, elem) => HOLogic_insert $ elem $ acc) (HOLogic_empty_set, elements))
86.804 + SOME (foldl (fn (acc, elem) => HOLogic_insert $ elem $ acc) (HOLogic_empty_set, elements))
86.805 end
86.806 | _ =>
86.807 - None
86.808 + NONE
86.809 end;
86.810
86.811 (* theory -> model -> Term.term -> interpretation -> (int -> bool) -> Term.term option *)
86.812 @@ -1795,15 +1795,15 @@
86.813 fun IDT_printer thy model t intr assignment =
86.814 let
86.815 (* Term.term -> Term.typ option *)
86.816 - fun typeof (Free (_, T)) = Some T
86.817 - | typeof (Var (_, T)) = Some T
86.818 - | typeof (Const (_, T)) = Some T
86.819 - | typeof _ = None
86.820 + fun typeof (Free (_, T)) = SOME T
86.821 + | typeof (Var (_, T)) = SOME T
86.822 + | typeof (Const (_, T)) = SOME T
86.823 + | typeof _ = NONE
86.824 in
86.825 case typeof t of
86.826 - Some (Type (s, Ts)) =>
86.827 + SOME (Type (s, Ts)) =>
86.828 (case DatatypePackage.datatype_info thy s of
86.829 - Some info => (* inductive datatype *)
86.830 + SOME info => (* inductive datatype *)
86.831 let
86.832 val (typs, _) = model
86.833 val index = #index info
86.834 @@ -1824,7 +1824,7 @@
86.835 val _ = (if element<0 then raise REFUTE ("IDT_printer", "invalid interpretation (no value assigned)") else ())
86.836 (* int option -- only recursive IDTs have an associated depth *)
86.837 val depth = assoc (typs, Type (s, Ts))
86.838 - val typs' = (case depth of None => typs | Some n => overwrite (typs, (Type (s, Ts), n-1)))
86.839 + val typs' = (case depth of NONE => typs | SOME n => overwrite (typs, (Type (s, Ts), n-1)))
86.840 (* int -> DatatypeAux.dtyp list -> Term.term list *)
86.841 fun make_args n [] =
86.842 if n<>0 then
86.843 @@ -1860,12 +1860,12 @@
86.844 make_term (n-c_size) cs
86.845 end