1. Sébastien Ferré
  2. ocaml-lib

Source

ocaml-lib / syntax.ml

Diff from to

File syntax.ml

 
 type t_list = Tokens.t list
 
+type decimal = int * int (* fraction and exponent *)
+
 open Tokens
 
 (* forbidden idents in syntax of logics *)
 
 open Format
 
+(*
 let rec power10 : int -> float =
       function
       | 0 -> 1.
       | p -> if p > 0
              then power10 (p-1) *. 10.
              else power10 (p+1) /. 10.
+*)
 
 let string_escaped : string -> string =
   fun s ->
     let s = string_of_int n in
     list_of_stream (from_string s)
 
-let toks_of_float : (float * int) -> t_list =
+let float_of_decimal : decimal -> float =
+  fun (frac,expo) ->
+    float_of_string (string_of_int frac ^ "e" ^ string_of_int expo)
+
+let toks_of_decimal : decimal -> t_list =
+  fun (frac,expo) ->
+    let sign, abs_frac =
+      if frac < 0
+      then "-", -frac
+      else "", frac in
+    let s_abs_frac = string_of_int abs_frac in
+    let l = String.length s_abs_frac in
+    let s =
+      if expo > 0 then 
+	sign ^ s_abs_frac ^ ".e" ^ string_of_int expo
+      else if expo = 0 then
+	sign ^ s_abs_frac ^ "."
+      else if expo >= (-l + 1) && expo <= (-1) then
+	sign ^ String.sub s_abs_frac 0 (l - (-expo)) ^ "." ^ String.sub s_abs_frac (l - (-expo)) (-expo)
+      else if expo = -l then
+	sign ^ "0." ^ s_abs_frac
+      else if expo <= -l then
+	sign ^ "0." ^ s_abs_frac ^ "e" ^ string_of_int (expo + l)
+      else assert false in
+    list_of_stream (from_string s)
+
+(*
+let toks_of_float : (int * int) -> t_list =
   fun (f,p) ->
     let sm = if f=0. then "" else string_of_int (int_of_float ((abs_float f) *. (power10 (-p)))) in
     let l = String.length sm in
         if l >= 3 & p+l <> 0 then String.sub sm 0 3 ^ "." ^ String.sub sm 3 (l-3) ^ exp (p+l-3)
         else "0." ^ sm ^ exp (p + l) in
     list_of_stream (from_string s)
+*)
 
 (* messages d'erreur syntaxique *)
 
   | [<'Nat n>] -> n
   | [<'MinusNat n>] -> (- n)
 
+(* get the fraction and exponent (integers) of a float number from its writing *)
+let decimal_of_sfloat : string -> decimal =
+  fun s ->
+      let l = String.length s in
+      let i_e, p =
+        try
+          let i_e = String.index s 'e' in
+          i_e,
+          int_of_string (String.sub s (i_e+1) (l-(i_e+1)))
+        with Not_found -> l, 0 in
+      let i_dot, frac, expo =
+        try 
+	  let i_dot = String.index s '.' in
+	  i_dot,
+	  int_of_string (String.sub s 0 i_dot ^ String.sub s (i_dot+1) (i_e - i_dot - 1)),
+	  p - (i_e - i_dot - 1)
+	with Not_found ->
+	  i_e,
+	  int_of_string (String.sub s 0 i_e),
+	  p in
+      frac, expo
+
 (* parsing a float *)
-let rec parse_float : t_stream -> float * int = parser
-  | [<s = parse_float0>] -> (float_of_string s, prec_of_sfloat s)
-and parse_float0 = parser
-(*  | [<'Dot; m2 = parse_float_decimal; s = parse_float4>] -> "." ^ m2 ^ s *)
-  | [<'Nat m1; s = parse_float2>] -> string_of_int m1 ^ s
-  | [<'MinusNat m1; s = parse_float2>] -> "-" ^ string_of_int m1 ^ s
-(*  | [<'Symbol "-"; 'Dot; m2 = parse_float_decimal; s = parse_float4>] -> "-." ^ m2 ^ s *)
-and parse_float2 = parser
-  | [<'Dot; s = parse_float3>] -> "." ^ s
-  | [<exp = parse_float4>] -> "." ^ exp
-and parse_float3 = parser
-  | [<m2 = parse_float_decimal; s = parse_float4>] -> m2 ^ s
-  | [<e = parse_float_e; s = parse_float5>] -> e ^ s
-  | [<exp = parse_float_exp>] -> exp
+let rec parse_decimal : t_stream -> decimal = parser
+  | [<s = parse_decimal0>] -> decimal_of_sfloat s (*float_of_string s, prec_of_sfloat s*)
+and parse_decimal0 = parser
+(*  | [<'Dot; m2 = parse_decimal_decimal; s = parse_decimal4>] -> "." ^ m2 ^ s *)
+  | [<'Nat m1; s = parse_decimal2>] -> string_of_int m1 ^ s
+  | [<'MinusNat m1; s = parse_decimal2>] -> "-" ^ string_of_int m1 ^ s
+(*  | [<'Symbol "-"; 'Dot; m2 = parse_decimal_decimal; s = parse_decimal4>] -> "-." ^ m2 ^ s *)
+and parse_decimal2 = parser
+  | [<'Dot; s = parse_decimal3>] -> "." ^ s
+  | [<exp = parse_decimal4>] -> "." ^ exp
+and parse_decimal3 = parser
+  | [<m2 = parse_decimal_decimal; s = parse_decimal4>] -> m2 ^ s
+  | [<e = parse_decimal_e; s = parse_decimal5>] -> e ^ s
+  | [<exp = parse_decimal_exp>] -> exp
   | [<>] -> ""
-and parse_float4 = parser
-  | [<e = parse_float_e; s = parse_float5>] -> e ^ s
-  | [<exp = parse_float_exp>] -> exp
+and parse_decimal4 = parser
+  | [<e = parse_decimal_e; s = parse_decimal5>] -> e ^ s
+  | [<exp = parse_decimal_exp>] -> exp
   | [<>] -> ""
-and parse_float5 = parser
-  | [<p = parse_float_decimal>] -> p
-  | [<p = parse_float_minus_decimal>] -> p
-and parse_float_decimal = parser
-  | [<'Nat 0; d = parse_float_decimal2>] -> "0" ^ d
+and parse_decimal5 = parser
+  | [<p = parse_decimal_decimal>] -> p
+  | [<p = parse_decimal_minus_decimal>] -> p
+and parse_decimal_decimal = parser
+  | [<'Nat 0; d = parse_decimal_decimal2>] -> "0" ^ d
   | [<'Nat d>] -> string_of_int d
-and parse_float_minus_decimal = parser
-  | [<'MinusNat 0; d = parse_float_decimal2>] -> "-0" ^ d
+and parse_decimal_minus_decimal = parser
+  | [<'MinusNat 0; d = parse_decimal_decimal2>] -> "-0" ^ d
   | [<'MinusNat d>] -> "-" ^ string_of_int d
-and parse_float_decimal2 = parser
-  | [<'Nat 0; d = parse_float_decimal2>] -> "0" ^ d
+and parse_decimal_decimal2 = parser
+  | [<'Nat 0; d = parse_decimal_decimal2>] -> "0" ^ d
   | [<'Nat d>] -> string_of_int d
   | [<>] -> ""
-and parse_float_e = parser
+and parse_decimal_e = parser
   | [<'Symbol "e">] -> "e"
   | [<'Symbol "E">] -> "e"
-and parse_float_exp = parser
+and parse_decimal_exp = parser
   | [<'Symbol exp when Str.string_match (Str.regexp "e[0-9]+$") exp 0>] -> exp
   | [<'Symbol exp when Str.string_match (Str.regexp "E[0-9]+$") exp 0>] -> exp
 
 (* parsing a number *)
-type num = Int of int | Float of (float * int)
+type num = Int of int | Float of decimal
 
 let rec parse_num : t_stream -> num = parser
-  | [<i,s = parse_num0>] ->
+  | [<i, s = parse_num0>] ->
       if i
       then Int (int_of_string s)
-      else Float (float_of_string s, prec_of_sfloat s)
+      else Float (decimal_of_sfloat s) (*float_of_string s, prec_of_sfloat s*)
 and parse_num0 = parser
 (*  | [<'Dot; m2 = parse_num_decimal; s = parse_num4>] -> false, "." ^ m2 ^ s *)
   | [<'Nat m1; i,s = parse_num2>] -> i, string_of_int m1 ^ s
 | [<>] -> default
 
 let parse_option_float ? (default=0.) n = parser
-| [<'Symbol "-"; 'Symbol s when s=n ?? wrong_option_name n; (x,_) = parse_float ?? "Syntax error: float expected after option -"^n>] -> x
+| [<'Symbol "-"; 'Symbol s when s=n ?? wrong_option_name n; dec = parse_decimal ?? "Syntax error: float expected after option -"^n>] -> float_of_decimal dec
 | [<>] -> default
 
 let parse_option_string ?(default="") n = parser