# HG changeset patch
# User wenzelm
# Date 1288465700 -7200
# Node ID ba13793594f079cc5dd23316d2420570a73fe396
# Parent  012ed4426fda048b34053d516acd5dd2ee4fa321
support for real valued preferences;

diff -r 012ed4426fda -r ba13793594f0 NEWS
--- a/NEWS	Sat Oct 30 16:33:58 2010 +0200
+++ b/NEWS	Sat Oct 30 21:08:20 2010 +0200
@@ -60,6 +60,8 @@
 floating-point notation that coincides with the inner syntax for
 float_token.
 
+* Support for real valued preferences (with approximative PGIP type).
+
 * Interpretation command 'interpret' accepts a list of equations like
 'interpretation' does.
 
diff -r 012ed4426fda -r ba13793594f0 src/Pure/ProofGeneral/pgip_types.ML
--- a/src/Pure/ProofGeneral/pgip_types.ML	Sat Oct 30 16:33:58 2010 +0200
+++ b/src/Pure/ProofGeneral/pgip_types.ML	Sat Oct 30 21:08:20 2010 +0200
@@ -22,8 +22,9 @@
 
     (* Types and values (used for preferences and dialogs) *)
 
-    datatype pgiptype = Pgipnull | Pgipbool | Pgipint of int option * int option | Pgipnat
-                      | Pgipstring | Pgipconst of string | Pgipchoice of pgipdtype list
+    datatype pgiptype =
+        Pgipnull | Pgipbool | Pgipint of int option * int option | Pgipnat | Pgipreal
+      | Pgipstring | Pgipconst of string | Pgipchoice of pgipdtype list
 
     and pgipdtype = Pgipdtype of string option * pgiptype  (* type with opt. description *)
 
@@ -70,7 +71,9 @@
     val read_pgipint       : (int option * int option) -> string -> int (* raises PGIP *)
     val read_pgipnat       : string -> int                              (* raises PGIP *)
     val read_pgipbool      : string -> bool                             (* raises PGIP *)
+    val read_pgipreal      : string -> real                             (* raises PGIP *)
     val read_pgipstring    : string -> string                           (* raises PGIP *)
+    val real_to_pgstring   : real -> string
     val int_to_pgstring    : int -> string
     val bool_to_pgstring   : bool -> string
     val string_to_pgstring : string -> string
@@ -203,6 +206,11 @@
                    else raise PGIP ("Invalid natural number: " ^ quote s)
        | NONE => raise PGIP ("Invalid natural number: " ^ quote s))
 
+fun read_pgipreal s =
+    (case Real.fromString s of
+         SOME x => x
+       | NONE => raise PGIP ("Invalid floating-point number: " ^ quote s))
+
 (* NB: we can maybe do without xml decode/encode here. *)
 fun read_pgipstring s =  (* non-empty strings, XML escapes decoded *)
     (case XML.parse_string s of
@@ -212,6 +220,8 @@
 
 val int_to_pgstring = signed_string_of_int
 
+val real_to_pgstring = signed_string_of_real
+
 fun string_to_pgstring s = XML.text s
 
 fun bool_to_pgstring b = if b then "true" else "false"
@@ -238,6 +248,7 @@
        | Pgipbool                            (* booleans: "true" or "false" *)
        | Pgipint of int option * int option  (* ranged integers, should be XSD canonical *)
        | Pgipnat                             (* naturals: non-negative integers (convenience) *)
+       | Pgipreal                            (* floating-point numbers *)
        | Pgipstring                          (* non-empty strings *)
        | Pgipconst of string                 (* singleton type *)
        | Pgipchoice of pgipdtype list        (* union type *)
@@ -246,8 +257,9 @@
 
 and pgipdtype = Pgipdtype of string option * pgiptype
 
-datatype pgipuval = Pgvalnull | Pgvalbool of bool | Pgvalint of int | Pgvalnat of int 
-                  | Pgvalstring of string | Pgvalconst of string
+datatype pgipuval =
+    Pgvalnull | Pgvalbool of bool | Pgvalint of int | Pgvalnat of int | Pgvalreal of real
+  | Pgvalstring of string | Pgvalconst of string
 
 type pgipval = pgiptype * pgipuval      (* type-safe values *)
 
@@ -260,6 +272,7 @@
                     | Pgipbool => "pgipbool"
                     | Pgipint _ => "pgipint"
                     | Pgipnat => "pgipint"
+                    | Pgipreal => "pgipint"  (* FIXME sic? *)
                     | Pgipstring => "pgipstring"
                     | Pgipconst _ => "pgipconst"
                     | Pgipchoice _ => "pgipchoice"
@@ -291,6 +304,7 @@
   | read_pguval Pgipbool s = Pgvalbool (read_pgipbool s)
   | read_pguval (Pgipint range) s = Pgvalint (read_pgipint range s)
   | read_pguval Pgipnat s = Pgvalnat (read_pgipnat s)
+  | read_pguval Pgipreal s = Pgvalreal (read_pgipreal s)
   | read_pguval (Pgipconst c) s = 
     if c=s then Pgvalconst c 
     else raise PGIP ("Given string: "^quote s^" doesn't match expected string: "^quote c)
@@ -315,6 +329,7 @@
   | pgval_to_string (_, Pgvalbool b) = bool_to_pgstring b
   | pgval_to_string (_, Pgvalnat n) = int_to_pgstring n
   | pgval_to_string (_, Pgvalint i) = int_to_pgstring i
+  | pgval_to_string (_, Pgvalreal x) = real_to_pgstring x
   | pgval_to_string (_, Pgvalconst c) = string_to_pgstring c
   | pgval_to_string (_, Pgvalstring s) = string_to_pgstring s
 
diff -r 012ed4426fda -r ba13793594f0 src/Pure/ProofGeneral/preferences.ML
--- a/src/Pure/ProofGeneral/preferences.ML	Sat Oct 30 16:33:58 2010 +0200
+++ b/src/Pure/ProofGeneral/preferences.ML	Sat Oct 30 21:08:20 2010 +0200
@@ -20,6 +20,7 @@
   val generic_pref: ('a -> string) -> (string -> 'a) -> PgipTypes.pgiptype ->
     'a Unsynchronized.ref -> string -> string -> preference
   val string_pref: string Unsynchronized.ref -> string -> string -> preference
+  val real_pref: real Unsynchronized.ref -> string -> string -> preference
   val int_pref: int Unsynchronized.ref -> string -> string -> preference
   val nat_pref: int Unsynchronized.ref -> string -> string -> preference
   val bool_pref: bool Unsynchronized.ref -> string -> string -> preference
@@ -65,6 +66,9 @@
 
 val string_pref = generic_pref I I PgipTypes.Pgipstring;
 
+val real_pref =
+  generic_pref PgipTypes.real_to_pgstring PgipTypes.read_pgipreal PgipTypes.Pgipreal;
+
 val int_pref =
   generic_pref PgipTypes.int_to_pgstring (PgipTypes.read_pgipint (NONE, NONE))
     (PgipTypes.Pgipint (NONE, NONE));