# HG changeset patch
# User chaieb
# Date 1169981572 -3600
# Node ID b617ddd200ebde19a34d4220d8136299a6974ac0
# Parent  226d29db8e0aeb4582150a4125a51042a973ac54
Now deals with simples cases where the input equations contain type variables
See example in ReflectionEx.thy

diff -r 226d29db8e0a -r b617ddd200eb src/HOL/ex/Reflection.thy
--- a/src/HOL/ex/Reflection.thy	Fri Jan 26 13:59:06 2007 +0100
+++ b/src/HOL/ex/Reflection.thy	Sun Jan 28 11:52:52 2007 +0100
@@ -7,11 +7,12 @@
 
 theory Reflection
 imports Main
-uses ("reflection.ML")
+  uses ("reflection.ML")
 begin
 
 lemma ext2: "(\<forall>x. f x = g x) \<Longrightarrow> f = g"
   by (blast intro: ext)
+
 use "reflection.ML"
 
 method_setup reify = {*
diff -r 226d29db8e0a -r b617ddd200eb src/HOL/ex/ReflectionEx.thy
--- a/src/HOL/ex/ReflectionEx.thy	Fri Jan 26 13:59:06 2007 +0100
+++ b/src/HOL/ex/ReflectionEx.thy	Sun Jan 28 11:52:52 2007 +0100
@@ -355,4 +355,38 @@
   apply (reify Irifm.simps Irnat_simps Irlist.simps Irint_simps)
 oops
 
+
+  (* An example for equations containing type variables *)	
+datatype prod = Zero | One | Var nat | Mul prod prod 
+  | Pw prod nat | PNM nat nat prod
+consts Iprod :: "('a::{ordered_idom,recpower}) list \<Rightarrow> prod \<Rightarrow> 'a" 
+primrec
+  "Iprod vs Zero = 0"
+  "Iprod vs One = 1"
+  "Iprod vs (Var n) = vs!n"
+  "Iprod vs (Mul a b) = (Iprod vs a * Iprod vs b)"
+  "Iprod vs (Pw a n) = ((Iprod vs a) ^ n)"
+  "Iprod vs (PNM n k t) = (vs ! n)^k * Iprod vs t"
+consts prodmul:: "prod \<times> prod \<Rightarrow> prod"
+datatype sgn = Pos prod | Neg prod | ZeroEq prod | NZeroEq prod | Tr | F 
+  | Or sgn sgn | And sgn sgn
+
+consts Isgn :: "('a::{ordered_idom, recpower}) list \<Rightarrow> sgn \<Rightarrow> bool"
+primrec 
+  "Isgn vs Tr = True"
+  "Isgn vs F = False"
+  "Isgn vs (ZeroEq t) = (Iprod vs t = 0)"
+  "Isgn vs (NZeroEq t) = (Iprod vs t \<noteq> 0)"
+  "Isgn vs (Pos t) = (Iprod vs t > 0)"
+  "Isgn vs (Neg t) = (Iprod vs t < 0)"
+  "Isgn vs (And p q) = (Isgn vs p \<and> Isgn vs q)"
+  "Isgn vs (Or p q) = (Isgn vs p \<or> Isgn vs q)"
+
+lemmas eqs = Isgn.simps Iprod.simps
+
+lemma "(x::int)^4 * y * z * y^2 * z^23 > 0"
+  apply (reify eqs)
+  oops
+
+
 end
diff -r 226d29db8e0a -r b617ddd200eb src/HOL/ex/reflection.ML
--- a/src/HOL/ex/reflection.ML	Fri Jan 26 13:59:06 2007 +0100
+++ b/src/HOL/ex/reflection.ML	Sun Jan 28 11:52:52 2007 +0100
@@ -38,7 +38,7 @@
    val (((_,_),[th']), ctxt') = Variable.import true [th] ctxt
    val (lhs, rhs) = HOLogic.dest_eq (HOLogic.dest_Trueprop (Thm.prop_of th'))
    fun add_fterms (t as t1 $ t2) = 
-       if exists (fn f => (t |> strip_comb |> fst) aconv f) fs then insert (op aconv) t
+       if exists (fn f => could_unify (t |> strip_comb |> fst, f)) fs then insert (op aconv) t
        else add_fterms t1 #> add_fterms t2
      | add_fterms (t as Abs(xn,xT,t')) = 
        if (fN mem (term_consts t)) then (fn _ => [t]) else (fn _ => [])
@@ -92,7 +92,7 @@
  let 
   val tt = HOLogic.listT (fastype_of t)
  in 
-  (case AList.lookup (op =) (!bds) tt of
+  (case AList.lookup Type.could_unify (!bds) tt of
     NONE => error "index_of : type not found in environements!"
   | SOME (tbs,tats) =>
     let
@@ -160,8 +160,8 @@
    in exists_Const 
 	  (fn (n,ty) => n="List.nth" 
 			andalso 
-			AList.defined (op =) (!bds) (domain_type ty)) rhs 
-	  andalso fastype_of rhs = tT
+			AList.defined Type.could_unify (!bds) (domain_type ty)) rhs 
+	  andalso Type.could_unify (fastype_of rhs, tT)
    end
   fun get_nth t = 
    case t of