added decode_term (belongs to Syntax module);
authorwenzelm
Sat, 21 Apr 2007 11:07:42 +0200
changeset 22763 5c1752279f25
parent 22762 f28f62754644
child 22764 ccbd31bc1ef7
added decode_term (belongs to Syntax module);
src/Pure/Isar/proof_context.ML
--- a/src/Pure/Isar/proof_context.ML	Sat Apr 21 01:34:15 2007 +0200
+++ b/src/Pure/Isar/proof_context.ML	Sat Apr 21 11:07:42 2007 +0200
@@ -50,6 +50,7 @@
   val get_skolem: Proof.context -> string -> string
   val revert_skolem: Proof.context -> string -> string
   val revert_skolems: Proof.context -> term -> term
+  val decode_term: Proof.context -> term -> term
   val read_termTs: Proof.context -> (string -> bool) -> (indexname -> typ option)
     -> (indexname -> sort option) -> string list -> (string * typ) list
     -> term list * (indexname * typ) list
@@ -478,25 +479,38 @@
   handle TERM _ => error "Illegal dummy pattern(s) in term";
 
 
+(* decoding raw terms (syntax trees) *)
+
+fun legacy_intern_skolem ctxt internal def_type x =    (* FIXME cleanup this mess *)
+  let
+    val sko = lookup_skolem ctxt x;
+    val is_const = can (Consts.read_const (consts_of ctxt)) x;
+    val is_free = is_some sko orelse not is_const;
+    val is_internal = internal x;
+    val is_declared = is_some (def_type (x, ~1));
+    val res =
+      if is_free andalso not is_internal then (no_skolem false x; sko)
+      else ((no_skolem false x; ()) handle ERROR msg => warning msg;
+        if is_internal andalso is_declared then SOME x else NONE);
+  in if is_some res then res else if is_declared then SOME x else NONE end;
+
+fun decode_term ctxt =
+  let
+    val thy = theory_of ctxt;
+    val get_sort = Sign.get_sort thy (Variable.def_sort ctxt);
+    val map_const = try (#1 o Term.dest_Const o Consts.read_const (consts_of ctxt));
+    val map_free = legacy_intern_skolem ctxt (K false) (Variable.def_type ctxt false);
+    val map_type = Sign.intern_tycons thy;
+    val map_sort = Sign.intern_sort thy;
+  in Syntax.decode_term get_sort map_const map_free map_type map_sort end;
+
+
 (* read terms *)
 
 local
 
 fun append_env e1 e2 x = (case e2 x of NONE => e1 x | some => some);
 
-fun legacy_intern_skolem ctxt internal x =
-  let
-    val sko = lookup_skolem ctxt x;
-    val is_const = can (Consts.read_const (consts_of ctxt)) x;
-    val is_free = is_some sko orelse not is_const;
-    val is_internal = internal x;
-    val is_declared = is_some (Variable.default_type ctxt x);
-  in
-    if is_free andalso not is_internal then (no_skolem false x; sko)
-    else ((no_skolem false x; ()) handle ERROR msg => warning msg;
-      if is_internal andalso is_declared then SOME x else NONE)
-  end;
-
 fun gen_read' read app pattern schematic
     ctxt internal more_types more_sorts more_used s =
   let
@@ -504,7 +518,8 @@
     val sorts = append_env (Variable.def_sort ctxt) more_sorts;
     val used = fold Name.declare more_used (Variable.names_of ctxt);
   in
-    (read (pp ctxt) (syn_of ctxt) ctxt (types, sorts, used) (legacy_intern_skolem ctxt internal) s
+    (read (pp ctxt) (syn_of ctxt) ctxt (types, sorts, used)
+        (legacy_intern_skolem ctxt internal types) s
       handle TERM (msg, _) => error msg)
     |> app (certify_consts ctxt)
     |> app (if pattern then I else expand_binds ctxt schematic)