Commits

Sébastien Ferré committed d5c9922

bug fix in string_escaped.
handling of floats.
more keywords.

  • Participants
  • Parent commits 274bf60

Comments (0)

Files changed (1)

 open Token
 
 (* forbidden idents in syntax of logics *)
-let keywords = ["and";"or";"not"]
+let keywords = ["all";"none";"and";"or";"not";"except";"implies";"only"]
 
 let not_PP t = not (Token.is_PP t)
 (*
   | [] -> 0
   | x::xs -> (if not_PP x then 1 else 0) + length xs
 
+(* deprecated -> moved into logics *)
+(*
 let rec get_terms : t_list -> string list =
   function
       [] -> []
     | Term name::l -> name::get_terms l
     | _::l -> get_terms l
+*)
 
 let from_channel : in_channel -> t_stream =
   fun ch ->
              then power10 (p-1) *. 10.
              else power10 (p+1) /. 10.
 
+let string_escaped : string -> string =
+  fun s ->
+    let l1 = String.length s in
+    let buf = Buffer.create (2 * l1) in
+    for i=0 to l1-1 do
+      if s.[i] = '"' then Buffer.add_string buf "\\\""
+      else if s.[i] = '\\' then Buffer.add_string buf "\\\\"
+      else Buffer.add_char buf s.[i]
+    done;
+    Buffer.contents buf
+
 let term_escaped : string -> string =
   fun s ->
-    let s1 = String.escaped s in
-    let l1 = String.length s1 in
+    let l1 = String.length s in
     let buf = Buffer.create (2 * l1) in
     for i=0 to l1-1 do
-      if s1.[i] = '\''
-      then Buffer.add_string buf "\\\'"
-      else Buffer.add_char buf s1.[i]
+      if s.[i] = '\'' then Buffer.add_string buf "\\\'"
+      else if s.[i] = '\\' then Buffer.add_string buf "\\\\"
+      else Buffer.add_char buf s.[i]
     done;
     Buffer.contents buf
 
     | LT -> pp_print_string ff "<"
     | GT -> pp_print_string ff ">"
     | Comma -> pp_print_string ff ","
+(*
     | DotDot ->
+(*
 	( match pred with
 	| Int _ | Float _ -> pp_print_string ff " "
 	| _ -> ());
+*)
 	pp_print_string ff ".."
+*)
     | Dot ->
+(*
 	( match pred with
 	| Int _ | Float _ -> pp_print_string ff " "
 	| _ -> ());
+*)
 	pp_print_string ff "."
     | Colon -> pp_print_string ff ":"
     | SemiColon -> pp_print_string ff ";"
 	| Ident _ | Term _ -> pp_print_string ff " "
 	| _ -> ());
 	pp_print_string ff s
+    | Nat n ->
+	(match pred with
+	| Nat _ | Ident _ | Term _ -> pp_print_string ff " "
+	| _ -> ());
+	pp_print_int ff n
+(*
     | Int n ->
 	( match pred with
 	| Plus | Minus | Int _ | Float _ | Ident _ | Term _ -> pp_print_string ff " "
             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
 	pp_print_string ff s
+*)
     | String s ->
-(*	pp_print_string ff ("\"" ^ String.escaped s ^ "\"") *)
-	pp_print_string ff ("\"" ^ Str.global_replace (Str.regexp "\"") "\\\"" s ^ "\"")
+	pp_print_string ff ("\"" ^ string_escaped s ^ "\"")
     | Term s ->
 	( match pred with
 	| Ident _ | Term _ -> pp_print_string ff " "
   fun n ->
     pp_print_int Format.std_formatter n
 
+
 (* fonctions generiques pour le printing *)
 (* ------------------------------------- *)
 
+(* printing a signed integer to tokens *)
+let toks_of_int : int -> t_list =
+  fun n ->
+    let s = string_of_int n in
+    list_of_stream (from_string s)
+
+let toks_of_float : (float * 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
+    let e = let x = (p+l) mod 3 in if x >= 0 then x else x+3 in
+    let exp e = if e = 0 then "" else "e" ^ string_of_int e in
+    let s =
+      (if f < 0. then "-" else "") ^
+      if e = 1 then
+	if l >= 1 & p+l+2 <> 0 then String.sub sm 0 1 ^ "." ^ String.sub sm 1 (l-1) ^ exp (p+l-1)
+	else "0.00" ^ sm ^ exp (p + l + 2)
+      else if e = 2 then
+        if l >= 2 & p+l+1 <> 0 then String.sub sm 0 2 ^ "." ^ String.sub sm 2 (l-2) ^ exp (p+l-2)
+        else "0.0" ^ sm ^ exp (p + l + 1)
+      else
+        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 *)
 
 let error_RightPar = "Syntax error: a closing parenthesis is missing."
 (* fonctions generiques pour le parsing *)
 (* ------------------------------------ *)
 
+(* parsing a signed integer *)
+let parse_int : t_stream -> int = parser
+  | [<'Nat n>] -> n
+  | [<'Plus; 'Nat n>] -> n
+  | [<'Minus; 'Nat n>] -> -n
+
+(* 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; 'Nat m2; s = parse_float4>] -> "." ^ string_of_int m2 ^ s
+  | [<'Nat m1; s = parse_float2>] -> string_of_int m1 ^ s
+  | [<sign = parse_float_sign; s = parse_float1>] -> sign ^ s
+and parse_float1 = parser
+  | [<'Nat m1; s = parse_float2>] -> string_of_int m1 ^ s
+  | [<'Dot; 'Nat m2; s = parse_float4>] -> "." ^ string_of_int m2 ^ s
+and parse_float2 = parser
+  | [<'Dot; s = parse_float3>] -> "." ^ s
+and parse_float3 = parser
+  | [<'Nat m2; s = parse_float4>] -> string_of_int m2 ^ s
+  | [<e = parse_float_e; s = parse_float5>] -> e ^ s
+  | [<exp = parse_float_exp>] -> exp
+  | [<>] -> ""
+and parse_float4 = parser
+  | [<e = parse_float_e; s = parse_float5>] -> e ^ s
+  | [<exp = parse_float_exp>] -> exp
+  | [<>] -> ""
+and parse_float5 = parser
+  | [<'Nat p>] -> string_of_int p
+  | [<sign = parse_float_sign; 'Nat p>] -> sign ^ string_of_int p
+and parse_float_sign = parser
+  | [<'Minus>] -> "-"
+  | [<'Plus>] -> ""
+and parse_float_e = parser
+  | [<'Ident "e">] -> "e"
+  | [<'Term "E">] -> "e"
+and parse_float_exp = parser
+  | [<'Ident exp when Str.string_match (Str.regexp "e[0-9]+$") exp 0>] -> exp
+  | [<'Term exp when Str.string_match (Str.regexp "E[0-9]+$") exp 0>] -> exp
+
+
 (* parsing of a list of tokens *)
 let rec parse_tokens : t_list -> t_stream -> unit =
 fun toks str ->
 
 (* parsing an indefinite number of pattern given some parser *)
 let rec parse_star p = parser
-  [<x = p; xs = parse_star p>] -> x::xs
-| [<>] -> []
+  | [<x = p; xs = parse_star p>] -> x::xs
+  | [<>] -> []
+
+let parse_plus p = parser
+  | [<x = p; xs = parse_star p>] -> x::xs
 
 (* optional parsing *)
 let parse_opt : (t_stream -> 'a) -> 'a -> (t_stream -> 'a) =
 | [<>] -> false
 
 let parse_option_int ?(default=0) n = parser
-| [<'Minus; 'Ident s when s=n ?? wrong_option_name n; 'Int i ?? "Syntax error: integer expected after option -"^n>] -> i
+| [<'Minus; 'Ident s when s=n ?? wrong_option_name n; i = parse_int ?? "Syntax error: integer expected after option -"^n>] -> i
 | [<>] -> default
 
 let parse_option_float ? (default=0.) n = parser
-| [<'Minus; 'Ident s when s=n ?? wrong_option_name n; 'Float (x,_) ?? "Syntax error: float expected after option -"^n>] -> x
+| [<'Minus; 'Ident s when s=n ?? wrong_option_name n; (x,_) = parse_float ?? "Syntax error: float expected after option -"^n>] -> x
 | [<>] -> default
 
 let parse_option_string ?(default="") n = parser