src/Pure/sign.ML
changeset 17102 a83a80f1c8dd
parent 17039 78159411623f
child 17184 3d80209e9a53
--- a/src/Pure/sign.ML	Thu Aug 18 11:17:36 2005 +0200
+++ b/src/Pure/sign.ML	Thu Aug 18 11:17:37 2005 +0200
@@ -49,6 +49,12 @@
     (string * string * (string -> string * real)) list -> theory -> theory
   val add_mode_tokentrfuns: string -> (string * (string -> string * real)) list
     -> theory -> theory
+  val parse_ast_translation: bool * string -> theory -> theory
+  val parse_translation: bool * string -> theory -> theory
+  val print_translation: bool * string -> theory -> theory
+  val typed_print_translation: bool * string -> theory -> theory
+  val print_ast_translation: bool * string -> theory -> theory
+  val token_translation: string -> theory -> theory
   val add_trrules: (xstring * string) Syntax.trrule list -> theory -> theory
   val add_trrules_i: ast Syntax.trrule list -> theory -> theory
   val add_path: string -> theory -> theory
@@ -774,6 +780,50 @@
 fun add_mode_tokentrfuns m = add_tokentrfuns o map (fn (s, f) => (m, s, f));
 
 
+(* compile translation functions *)
+
+local
+
+fun advancedT false = ""
+  | advancedT true = "theory -> ";
+
+fun advancedN false = ""
+  | advancedN true = "advanced_";
+
+in
+
+fun parse_ast_translation (a, txt) =
+  txt |> Context.use_let ("val parse_ast_translation: (string * (" ^ advancedT a ^
+      "Syntax.ast list -> Syntax.ast)) list")
+    ("Sign.add_" ^ advancedN a ^ "trfuns (parse_ast_translation, [], [], [])");
+
+fun parse_translation (a, txt) =
+  txt |> Context.use_let ("val parse_translation: (string * (" ^ advancedT a ^
+      "term list -> term)) list")
+    ("Sign.add_" ^ advancedN a ^ "trfuns ([], parse_translation, [], [])");
+
+fun print_translation (a, txt) =
+  txt |> Context.use_let ("val print_translation: (string * (" ^ advancedT a ^
+      "term list -> term)) list")
+    ("Sign.add_" ^ advancedN a ^ "trfuns ([], [], print_translation, [])");
+
+fun print_ast_translation (a, txt) =
+  txt |> Context.use_let ("val print_ast_translation: (string * (" ^ advancedT a ^
+      "Syntax.ast list -> Syntax.ast)) list")
+    ("Sign.add_" ^ advancedN a ^ "trfuns ([], [], [], print_ast_translation)");
+
+fun typed_print_translation (a, txt) =
+  txt |> Context.use_let ("val typed_print_translation: (string * (" ^ advancedT a ^
+      "bool -> typ -> term list -> term)) list")
+    ("Sign.add_" ^ advancedN a ^ "trfunsT typed_print_translation");
+
+val token_translation =
+  Context.use_let "val token_translation: (string * string * (string -> string * real)) list"
+    "Sign.add_tokentrfuns token_translation";
+
+end;
+
+
 (* add translation rules *)
 
 fun add_trrules args thy = thy |> map_syn (fn syn =>