# HG changeset patch
# User wenzelm
# Date 1271407930 -7200
# Node ID 0bd034a80a9a7e9b318f1214ef148fbcfc96b0ff
# Parent  e30e51b7e4dcf455ef756d106208bb1ac1de9e2b
added ML antiquotation @{make_string}, which produces proper pretty printed version in Poly/ML 5.3.0 or later;

diff -r e30e51b7e4dc -r 0bd034a80a9a NEWS
--- a/NEWS	Fri Apr 16 10:15:00 2010 +0200
+++ b/NEWS	Fri Apr 16 10:52:10 2010 +0200
@@ -298,6 +298,10 @@
 * Antiquotation @{syntax_const NAME} ensures that NAME refers to a raw
 syntax constant (cf. 'syntax' command).
 
+* Antiquotation @{make_string} inlines a function to print arbitrary
+values similar to the ML toplevel.  The result is compiler dependent
+and may fall back on "?" in certain situations.
+
 * Renamed old-style Drule.standard to Drule.export_without_context, to
 emphasize that this is in no way a standard operation.
 INCOMPATIBILITY.
diff -r e30e51b7e4dc -r 0bd034a80a9a src/Pure/ML-Systems/polyml.ML
--- a/src/Pure/ML-Systems/polyml.ML	Fri Apr 16 10:15:00 2010 +0200
+++ b/src/Pure/ML-Systems/polyml.ML	Fri Apr 16 10:52:10 2010 +0200
@@ -66,3 +66,6 @@
   use_text context (1, "pp") false
     ("PolyML.addPrettyPrinter (fn _ => fn _ => ml_pretty o Pretty.to_ML o (" ^ pp ^ "))");
 
+val ml_make_string =
+  "(fn x => Pretty.string_of (Pretty.from_ML (pretty_ml (PolyML.prettyRepresentation (x, get_print_depth ())))))";
+
diff -r e30e51b7e4dc -r 0bd034a80a9a src/Pure/ML-Systems/polyml_common.ML
--- a/src/Pure/ML-Systems/polyml_common.ML	Fri Apr 16 10:15:00 2010 +0200
+++ b/src/Pure/ML-Systems/polyml_common.ML	Fri Apr 16 10:52:10 2010 +0200
@@ -55,7 +55,7 @@
 fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
 
 
-(* print depth *)
+(* toplevel printing *)
 
 local
   val depth = Unsynchronized.ref 10;
@@ -66,6 +66,8 @@
 
 val error_depth = PolyML.error_depth;
 
+val ml_make_string = "PolyML.makestring";
+
 
 
 (** interrupts **)
diff -r e30e51b7e4dc -r 0bd034a80a9a src/Pure/ML-Systems/smlnj.ML
--- a/src/Pure/ML-Systems/smlnj.ML	Fri Apr 16 10:15:00 2010 +0200
+++ b/src/Pure/ML-Systems/smlnj.ML	Fri Apr 16 10:52:10 2010 +0200
@@ -61,6 +61,8 @@
     Control.Print.printLength := dest_int n);
 end;
 
+val ml_make_string = "(fn _ => \"?\")";
+
 
 (*prompts*)
 fun ml_prompts p1 p2 =
diff -r e30e51b7e4dc -r 0bd034a80a9a src/Pure/ML/ml_antiquote.ML
--- a/src/Pure/ML/ml_antiquote.ML	Fri Apr 16 10:15:00 2010 +0200
+++ b/src/Pure/ML/ml_antiquote.ML	Fri Apr 16 10:52:10 2010 +0200
@@ -59,6 +59,8 @@
 
 structure P = OuterParse;
 
+val _ = inline "make_string" (Scan.succeed ml_make_string);
+
 val _ = value "binding"
   (Scan.lift (P.position Args.name) >> (fn name => ML_Syntax.atomic (ML_Syntax.make_binding name)));