added idtypdummy_ast_tr;
authorwenzelm
Fri, 07 Oct 2005 22:59:26 +0200
changeset 17788 86c46583670f
parent 17787 b6e0d8323c0e
child 17789 ccba4e900023
added idtypdummy_ast_tr; removed obsolete k_tr;
src/Pure/Syntax/syn_trans.ML
--- a/src/Pure/Syntax/syn_trans.ML	Fri Oct 07 22:59:25 2005 +0200
+++ b/src/Pure/Syntax/syn_trans.ML	Fri Oct 07 22:59:26 2005 +0200
@@ -78,39 +78,39 @@
 
 (* abstraction *)
 
-fun idtyp_ast_tr (*"_idtyp"*) [x, ty] = Ast.Appl [Ast.Constant SynExt.constrainC, x, ty]
+fun idtyp_ast_tr (*"_idtyp"*) [x, ty] = Ast.Appl [Ast.Constant "_constrain", x, ty]
   | idtyp_ast_tr (*"_idtyp"*) asts = raise Ast.AST ("idtyp_ast_tr", asts);
 
+fun idtypdummy_ast_tr (*"_idtypdummy"*) [ty] =
+      Ast.Appl [Ast.Constant "_constrain", Ast.Constant "_idtdummy", ty]
+  | idtypdummy_ast_tr (*"_idtypdummy"*) asts = raise Ast.AST ("idtyp_ast_tr", asts);
+
 fun lambda_ast_tr (*"_lambda"*) [pats, body] =
       Ast.fold_ast_p "_abs" (Ast.unfold_ast "_pttrns" pats, body)
   | lambda_ast_tr (*"_lambda"*) asts = raise Ast.AST ("lambda_ast_tr", asts);
 
 val constrainAbsC = "_constrainAbs";
 
-fun abs_tr (*"_abs"*) [Free (x, T), body] = Term.absfree (x, T, body)
-  | abs_tr (*"_abs"*) (ts as [Const (c, _) $ Free (x, T) $ tT, body]) =
-      if c = SynExt.constrainC
-        then Lexicon.const constrainAbsC $ Term.absfree (x, T, body) $ tT
-      else raise TERM ("abs_tr", ts)
+fun abs_tr (*"_abs"*) [Free (x, T), t] = Term.absfree (x, T, t)
+  | abs_tr (*"_abs"*) [Const ("_idtdummy", T), t] = Term.absdummy (T, t)
+  | abs_tr (*"_abs"*) [Const ("_constrain", _) $ Free (x, T) $ tT, t] =
+      Lexicon.const constrainAbsC $ Term.absfree (x, T, t) $ tT
+  | abs_tr (*"_abs"*) [Const ("_constrain", _) $ Const ("_idtdummy", T) $ tT, t] =
+      Lexicon.const constrainAbsC $ Term.absdummy (T, t) $ tT
   | abs_tr (*"_abs"*) ts = raise TERM ("abs_tr", ts);
 
 
-(* nondependent abstraction *)
-
-fun k_tr (*"_K"*) [t] = Abs ("uu", dummyT, Term.incr_boundvars 1 t)
-  | k_tr (*"_K"*) ts = raise TERM ("k_tr", ts);
-
-
 (* binder *)
 
 fun mk_binder_tr (sy, name) =
   let
     fun tr (Free (x, T), t) = Lexicon.const name $ Term.absfree (x, T, t)
+      | tr (Const ("_idtdummy", T), t) = Lexicon.const name $ Term.absdummy (T, t)
+      | tr (Const ("_constrain", _) $ Free (x, T) $ tT, t) =
+            Lexicon.const name $ (Lexicon.const constrainAbsC $ Term.absfree (x, T, t) $ tT)
+      | tr (Const ("_constrain", _) $ Const ("_idtdummy", T) $ tT, t) =
+            Lexicon.const name $ (Lexicon.const constrainAbsC $ Term.absdummy (T, t) $ tT)
       | tr (Const ("_idts", _) $ idt $ idts, t) = tr (idt, tr (idts, t))
-      | tr (t1 as Const (c, _) $ Free (x, T) $ tT, t) =
-          if c = SynExt.constrainC then
-            Lexicon.const name $ (Lexicon.const constrainAbsC $ Term.absfree (x, T, t) $ tT)
-          else raise TERM ("binder_tr", [t1, t])
       | tr (t1, t2) = raise TERM ("binder_tr", [t1, t2]);
 
     fun binder_tr (*sy*) [idts, body] = tr (idts, body)
@@ -120,11 +120,11 @@
 
 (* meta propositions *)
 
-fun aprop_tr (*"_aprop"*) [t] = Lexicon.const SynExt.constrainC $ t $ Lexicon.const "prop"
+fun aprop_tr (*"_aprop"*) [t] = Lexicon.const "_constrain" $ t $ Lexicon.const "prop"
   | aprop_tr (*"_aprop"*) ts = raise TERM ("aprop_tr", ts);
 
 fun ofclass_tr (*"_ofclass"*) [ty, cls] =
-      cls $ (Lexicon.const SynExt.constrainC $ Lexicon.const "TYPE" $
+      cls $ (Lexicon.const "_constrain" $ Lexicon.const "TYPE" $
         (Lexicon.const "itself" $ ty))
   | ofclass_tr (*"_ofclass"*) ts = raise TERM ("ofclass_tr", ts);
 
@@ -143,7 +143,7 @@
 (* type reflection *)
 
 fun type_tr (*"_TYPE"*) [ty] =
-      Lexicon.const SynExt.constrainC $ Lexicon.const "TYPE" $ (Lexicon.const "itself" $ ty)
+      Lexicon.const "_constrain" $ Lexicon.const "TYPE" $ (Lexicon.const "itself" $ ty)
   | type_tr (*"_TYPE"*) ts = raise TERM ("type_tr", ts);
 
 
@@ -307,7 +307,7 @@
 (* idtyp constraints *)
 
 fun idtyp_ast_tr' a [Ast.Appl [Ast.Constant c, x, ty], xs] =
-      if c = SynExt.constrainC then
+      if c = "_constrain" then
         Ast.Appl [ Ast.Constant a,  Ast.Appl [Ast.Constant "_idtyp", x, ty], xs]
       else raise Match
   | idtyp_ast_tr' _ _ = raise Match;
@@ -436,11 +436,11 @@
 
 val pure_trfuns =
  ([("_constify", constify_ast_tr), ("_appl", appl_ast_tr), ("_applC", applC_ast_tr),
-   ("_lambda", lambda_ast_tr), ("_idtyp", idtyp_ast_tr), ("_bigimpl", bigimpl_ast_tr),
-   ("_indexdefault", indexdefault_ast_tr), ("_indexnum", indexnum_ast_tr),
-   ("_indexvar", indexvar_ast_tr), ("_struct", struct_ast_tr)],
+   ("_lambda", lambda_ast_tr), ("_idtyp", idtyp_ast_tr), ("_idtypdummy", idtypdummy_ast_tr),
+   ("_bigimpl", bigimpl_ast_tr), ("_indexdefault", indexdefault_ast_tr),
+   ("_indexnum", indexnum_ast_tr), ("_indexvar", indexvar_ast_tr), ("_struct", struct_ast_tr)],
   [("_abs", abs_tr), ("_aprop", aprop_tr), ("_ofclass", ofclass_tr),
-   ("_TYPE", type_tr), ("_DDDOT", dddot_tr), ("_K", k_tr),
+   ("_TYPE", type_tr), ("_DDDOT", dddot_tr),
    ("_index", index_tr)],
   [("all", meta_conjunction_tr')],
   [("_abs", abs_ast_tr'), ("_idts", idtyp_ast_tr' "_idts"),