src/HOL/Library/Sum_Of_Squares/positivstellensatz_tools.ML
changeset 32828 ad76967c703d
parent 32646 962b4354ed90
child 32829 671eb46eb0a3
--- a/src/HOL/Library/Sum_Of_Squares/positivstellensatz_tools.ML	Thu Oct 01 18:59:26 2009 +0200
+++ b/src/HOL/Library/Sum_Of_Squares/positivstellensatz_tools.ML	Tue Sep 22 14:17:54 2009 +0200
@@ -16,8 +16,6 @@
 structure PositivstellensatzTools : POSITIVSTELLENSATZ_TOOLS =
 struct
 
-open RealArith FuncUtil
-
 (*** certificate generation ***)
 
 fun string_of_rat r =
@@ -41,42 +39,42 @@
   end
 
 fun string_of_monomial m = 
- if Ctermfunc.is_undefined m then "1" 
+ if FuncUtil.Ctermfunc.is_undefined m then "1" 
  else 
   let 
-   val m' = dest_monomial m
+   val m' = FuncUtil.dest_monomial m
    val vps = fold_rev (fn (x,k) => cons (string_of_varpow x k)) m' [] 
   in foldr1 (fn (s, t) => s ^ "*" ^ t) vps
   end
 
 fun string_of_cmonomial (m,c) =
-  if Ctermfunc.is_undefined m then string_of_rat c
+  if FuncUtil.Ctermfunc.is_undefined m then string_of_rat c
   else if c = Rat.one then string_of_monomial m
   else (string_of_rat c) ^ "*" ^ (string_of_monomial m);
 
 fun string_of_poly p = 
- if Monomialfunc.is_undefined p then "0" 
+ if FuncUtil.Monomialfunc.is_undefined p then "0" 
  else
   let 
    val cms = map string_of_cmonomial
-     (sort (prod_ord monomial_order (K EQUAL)) (Monomialfunc.graph p))
+     (sort (prod_ord FuncUtil.monomial_order (K EQUAL)) (FuncUtil.Monomialfunc.graph p))
   in foldr1 (fn (t1, t2) => t1 ^ " + " ^ t2) cms
   end;
 
-fun pss_to_cert (Axiom_eq i) = "A=" ^ string_of_int i
-  | pss_to_cert (Axiom_le i) = "A<=" ^ string_of_int i
-  | pss_to_cert (Axiom_lt i) = "A<" ^ string_of_int i
-  | pss_to_cert (Rational_eq r) = "R=" ^ string_of_rat r
-  | pss_to_cert (Rational_le r) = "R<=" ^ string_of_rat r
-  | pss_to_cert (Rational_lt r) = "R<" ^ string_of_rat r
-  | pss_to_cert (Square p) = "[" ^ string_of_poly p ^ "]^2"
-  | pss_to_cert (Eqmul (p, pss)) = "([" ^ string_of_poly p ^ "] * " ^ pss_to_cert pss ^ ")"
-  | pss_to_cert (Sum (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " + " ^ pss_to_cert pss2 ^ ")"
-  | pss_to_cert (Product (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " * " ^ pss_to_cert pss2 ^ ")"
+fun pss_to_cert (RealArith.Axiom_eq i) = "A=" ^ string_of_int i
+  | pss_to_cert (RealArith.Axiom_le i) = "A<=" ^ string_of_int i
+  | pss_to_cert (RealArith.Axiom_lt i) = "A<" ^ string_of_int i
+  | pss_to_cert (RealArith.Rational_eq r) = "R=" ^ string_of_rat r
+  | pss_to_cert (RealArith.Rational_le r) = "R<=" ^ string_of_rat r
+  | pss_to_cert (RealArith.Rational_lt r) = "R<" ^ string_of_rat r
+  | pss_to_cert (RealArith.Square p) = "[" ^ string_of_poly p ^ "]^2"
+  | pss_to_cert (RealArith.Eqmul (p, pss)) = "([" ^ string_of_poly p ^ "] * " ^ pss_to_cert pss ^ ")"
+  | pss_to_cert (RealArith.Sum (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " + " ^ pss_to_cert pss2 ^ ")"
+  | pss_to_cert (RealArith.Product (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " * " ^ pss_to_cert pss2 ^ ")"
 
-fun pss_tree_to_cert Trivial = "()"
-  | pss_tree_to_cert (Cert pss) = "(" ^ pss_to_cert pss ^ ")"
-  | pss_tree_to_cert (Branch (t1, t2)) = "(" ^ pss_tree_to_cert t1 ^ " & " ^ pss_tree_to_cert t2 ^ ")"
+fun pss_tree_to_cert RealArith.Trivial = "()"
+  | pss_tree_to_cert (RealArith.Cert pss) = "(" ^ pss_to_cert pss ^ ")"
+  | pss_tree_to_cert (RealArith.Branch (t1, t2)) = "(" ^ pss_tree_to_cert t1 ^ " & " ^ pss_tree_to_cert t2 ^ ")"
 
 (*** certificate parsing ***)
 
@@ -103,27 +101,27 @@
   (fn (x, k) => (cterm_of (Context.theory_of_proof ctxt) (Free (x, @{typ real})), k)) 
 
 fun parse_monomial ctxt = repeat_sep "*" (parse_varpow ctxt) >>
-  foldl (uncurry Ctermfunc.update) Ctermfunc.undefined
+  foldl (uncurry FuncUtil.Ctermfunc.update) FuncUtil.Ctermfunc.undefined
 
 fun parse_cmonomial ctxt =
   rat_int --| str "*" -- (parse_monomial ctxt) >> swap ||
   (parse_monomial ctxt) >> (fn m => (m, Rat.one)) ||
-  rat_int >> (fn r => (Ctermfunc.undefined, r))
+  rat_int >> (fn r => (FuncUtil.Ctermfunc.undefined, r))
 
 fun parse_poly ctxt = repeat_sep "+" (parse_cmonomial ctxt) >>
-  foldl (uncurry Monomialfunc.update) Monomialfunc.undefined
+  foldl (uncurry FuncUtil.Monomialfunc.update) FuncUtil.Monomialfunc.undefined
 
 (* positivstellensatz parser *)
 
 val parse_axiom =
-  (str "A=" |-- int >> Axiom_eq) ||
-  (str "A<=" |-- int >> Axiom_le) ||
-  (str "A<" |-- int >> Axiom_lt)
+  (str "A=" |-- int >> RealArith.Axiom_eq) ||
+  (str "A<=" |-- int >> RealArith.Axiom_le) ||
+  (str "A<" |-- int >> RealArith.Axiom_lt)
 
 val parse_rational =
-  (str "R=" |-- rat_int >> Rational_eq) ||
-  (str "R<=" |-- rat_int >> Rational_le) ||
-  (str "R<" |-- rat_int >> Rational_lt)
+  (str "R=" |-- rat_int >> RealArith.Rational_eq) ||
+  (str "R<=" |-- rat_int >> RealArith.Rational_le) ||
+  (str "R<" |-- rat_int >> RealArith.Rational_lt)
 
 fun parse_cert ctxt input =
   let
@@ -132,10 +130,10 @@
   in
   (parse_axiom ||
    parse_rational ||
-   str "[" |-- pp --| str "]^2" >> Square ||
-   str "([" |-- pp --| str "]*" -- pc --| str ")" >> Eqmul ||
-   str "(" |-- pc --| str "*" -- pc --| str ")" >> Product ||
-   str "(" |-- pc --| str "+" -- pc --| str ")" >> Sum) input
+   str "[" |-- pp --| str "]^2" >> RealArith.Square ||
+   str "([" |-- pp --| str "]*" -- pc --| str ")" >> RealArith.Eqmul ||
+   str "(" |-- pc --| str "*" -- pc --| str ")" >> RealArith.Product ||
+   str "(" |-- pc --| str "+" -- pc --| str ")" >> RealArith.Sum) input
   end
 
 fun parse_cert_tree ctxt input =
@@ -143,9 +141,9 @@
     val pc = parse_cert ctxt
     val pt = parse_cert_tree ctxt
   in
-  (str "()" >> K Trivial ||
-   str "(" |-- pc --| str ")" >> Cert ||
-   str "(" |-- pt --| str "&" -- pt --| str ")" >> Branch) input
+  (str "()" >> K RealArith.Trivial ||
+   str "(" |-- pc --| str ")" >> RealArith.Cert ||
+   str "(" |-- pt --| str "&" -- pt --| str ")" >> RealArith.Branch) input
   end
 
 (* scanner *)