Commits

Sébastien Ferré  committed 1bbf3e1

Token replaced by Tokens.
Symbol replacing Ident and Term.

  • Participants
  • Parent commits 66c846b

Comments (0)

Files changed (1)

 
 (* analyse lexicale générique *)
 
-type t_stream = Token.t Stream.t
+type t_stream = Tokens.t Stream.t
 
-type t_list = Token.t list
+type t_list = Tokens.t list
 
-open Token
+open Tokens
 
 (* forbidden idents in syntax of logics *)
 let keywords = ["thing";"nothing";"and";"or";"not";"except";"implies";"if";"then";"else";"some";"every";"only";"something";"the";"of";"by";"with";"is";"trans";"opt";"co";"share";"a";"an";"this";"that";"whose"]
 
-let not_PP t = not (Token.is_PP t)
+let not_PP t = not (Tokens.is_PP t)
 (*
 function
   | PP_tilda | PP_space | PP_cut | PP_break _ | PP_newline -> false
     done;
     Buffer.contents buf
 
-let pp_print_token : formatter -> Token.t -> Token.t -> unit =
+let pp_print_token : formatter -> Tokens.t -> Tokens.t -> unit =
   fun ff pred -> function
     | BackQuote -> pp_print_string ff "`"
-    | Tilda -> pp_print_string ff "~"
     | Exclam -> pp_print_string ff "!"
-    | At -> pp_print_string ff "@"
-    | Sharp -> pp_print_string ff "#"
-    | Dollar -> pp_print_string ff "$"
-    | Percent -> pp_print_string ff "%"
-    | Hat -> pp_print_string ff "^"
-    | Et -> pp_print_string ff "&"
-    | Star -> pp_print_string ff "*"
     | LeftPar -> pp_print_string ff "("
     | RightPar -> pp_print_string ff ")"
-    | Minus -> pp_print_string ff "-"
-    | Plus -> pp_print_string ff "+"
-    | Equal -> pp_print_string ff "="
     | LeftAcc -> pp_print_string ff "{"
     | RightAcc -> pp_print_string ff "}"
     | LeftBra -> pp_print_string ff "["
     | RightBra -> pp_print_string ff "]"
-    | Pipe -> pp_print_string ff "|"
-    | BackSlash -> pp_print_string ff "\\"
-    | Slash -> pp_print_string ff "/"
     | Interro -> pp_print_string ff "?"
-    | 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 "."
+    | Dot -> pp_print_string ff "."
     | Colon -> pp_print_string ff ":"
     | SemiColon -> pp_print_string ff ";"
     | DoubleQuote -> pp_print_string ff "\""
     | Quote -> pp_print_string ff "'"
-    | Ident s ->
-	( match pred with
-	| Ident _ | Term _ -> pp_print_string ff " "
-	| _ -> ());
-	pp_print_string ff s
     | Nat n ->
 	(match pred with
-	| Nat 0 -> ()
-	| 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 " "
+	| Nat 0 | MinusNat 0 -> ()
+	| Nat _ | MinusNat _ | Symbol _ -> pp_print_string ff " "
 	| _ -> ());
 	pp_print_int ff n
-    | Float (f,p) ->
-	( match pred with
-	| Plus | Minus | Int _ | Float _ | Ident _ | Term _ -> pp_print_string ff " "
+    | MinusNat n ->
+	(match pred with
+	| Nat 0 | MinusNat 0 -> ()
+	| Nat _ | MinusNat _ | Symbol _ -> pp_print_string ff " "
 	| _ -> ());
-        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
-	pp_print_string ff s
-*)
+	pp_print_string ff "-"; pp_print_int ff n
     | String s ->
 	pp_print_string ff ("\"" ^ string_escaped s ^ "\"")
-    | Term s ->
+    | Char c ->
+	pp_print_string ff ("`" ^ Char.escaped c ^ "`")
+    | Symbol s ->
 	( match pred with
-	| Ident _ | Term _ -> pp_print_string ff " "
+	| Nat _ | MinusNat _ | Symbol _ -> pp_print_string ff " "
 	| _ -> ());
-	let b = ref true in
-	(match s.[0] with 'A'..'Z' | '_' -> () | _ -> b:= false);
-	if !b then String.iter (function 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> () | _ -> b:= false) s;
-	if !b
-	then pp_print_string ff s
-	else pp_print_string ff ("'" ^ term_escaped s ^ "'")
-    | Char c -> pp_print_string ff ("`" ^ Char.escaped c ^ "`")
+	if Tokens.symbol_needs_quotes s
+	then pp_print_string ff ("'" ^ term_escaped s ^ "'")
+	else pp_print_string ff s
     | PP_tilda -> pp_print_string ff " "
     | PP_space -> pp_print_space ff ()
     | PP_cut -> pp_print_cut ff ()
 (* parsing a signed integer *)
 let parse_int : t_stream -> int = parser
   | [<'Nat n>] -> n
-  | [<'Plus; 'Nat n>] -> n
-  | [<'Minus; 'Nat n>] -> -n
+  | [<'MinusNat 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; m2 = parse_float_decimal; s = parse_float4>] -> "." ^ m2 ^ s
+(*  | [<'Dot; m2 = parse_float_decimal; s = parse_float4>] -> "." ^ 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; m2 = parse_float_decimal; s = parse_float4>] -> "." ^ m2 ^ 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_float5 = parser
   | [<p = parse_float_decimal>] -> p
-  | [<sign = parse_float_sign; p = parse_float_decimal>] -> sign ^ p
-and parse_float_sign = parser
-  | [<'Minus>] -> "-"
-  | [<'Plus>] -> ""
+  | [<p = parse_float_minus_decimal>] -> p
 and parse_float_decimal = parser
   | [<'Nat 0; d = parse_float_decimal2>] -> "0" ^ d
   | [<'Nat d>] -> string_of_int d
+and parse_float_minus_decimal = parser
+  | [<'MinusNat 0; d = parse_float_decimal2>] -> "-0" ^ d
+  | [<'MinusNat d>] -> "-" ^ string_of_int d
 and parse_float_decimal2 = parser
   | [<'Nat 0; d = parse_float_decimal2>] -> "0" ^ d
   | [<'Nat d>] -> string_of_int d
   | [<>] -> ""
 and parse_float_e = parser
-  | [<'Ident "e">] -> "e"
-  | [<'Term "E">] -> "e"
+  | [<'Symbol "e">] -> "e"
+  | [<'Symbol "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
+  | [<'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)
       then Int (int_of_string s)
       else Float (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
-  | [<sign = parse_num_sign; i,s = parse_num1>] -> i, sign ^ s
-and parse_num1 = parser
+(*  | [<'Dot; m2 = parse_num_decimal; s = parse_num4>] -> false, "." ^ m2 ^ s *)
   | [<'Nat m1; i,s = parse_num2>] -> i, string_of_int m1 ^ s
-  | [<'Dot; m2 = parse_num_decimal; s = parse_num4>] -> false, "." ^ m2 ^ s
+  | [<'MinusNat m1; i,s = parse_num2>] -> i, "-" ^ string_of_int m1 ^ s
+(*  | [<'Symbol "-"; 'Dot; m2 = parse_num_decimal; s = parse_num4>] -> false, "-." ^ m2 ^ s *)
 and parse_num2 = parser
   | [<'Dot; s = parse_num3>] -> false, "." ^ s
   | [<exp = parse_num4>] -> if exp = "" then true, "" else false, ("." ^ exp)
   | [<>] -> ""
 and parse_num5 = parser
   | [<p = parse_num_decimal>] -> p
-  | [<sign = parse_num_sign; p = parse_num_decimal>] -> sign ^ p
-and parse_num_sign = parser
-  | [<'Minus>] -> "-"
-  | [<'Plus>] -> ""
+  | [<p = parse_num_minus_decimal>] -> p
 and parse_num_decimal = parser
   | [<'Nat 0; d = parse_num_decimal2>] -> "0" ^ d
   | [<'Nat d>] -> string_of_int d
+and parse_num_minus_decimal = parser
+  | [<'MinusNat 0; d = parse_num_decimal2>] -> "-0" ^ d
+  | [<'MinusNat d>] -> "-" ^ string_of_int d
 and parse_num_decimal2 = parser
   | [<'Nat 0; d = parse_num_decimal2>] -> "0" ^ d
   | [<'Nat d>] -> string_of_int d
   | [<>] -> ""
 and parse_num_e = parser
-  | [<'Ident "e">] -> "e"
-  | [<'Term "E">] -> "e"
+  | [<'Symbol "e">] -> "e"
+  | [<'Symbol "E">] -> "e"
 and parse_num_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
+  | [<'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 of a list of tokens *)
 let wrong_option_name n = "Syntax error in some option: '"^n^"' expected after '-'"
 
 let parse_option_bool n = parser
-| [<'Minus; 'Ident s ?? wrong_option_name n>] -> s=n or raise (Stream.Error (wrong_option s n))
+| [<'Symbol "-"; 'Symbol s ?? wrong_option_name n>] -> s=n or raise (Stream.Error (wrong_option s n))
 | [<>] -> false
 
 let parse_option_int ?(default=0) n = parser
-| [<'Minus; 'Ident s when s=n ?? wrong_option_name n; i = parse_int ?? "Syntax error: integer expected after option -"^n>] -> i
+| [<'Symbol "-"; 'Symbol 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; (x,_) = parse_float ?? "Syntax error: float expected after option -"^n>] -> x
+| [<'Symbol "-"; 'Symbol 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
-| [<'Minus; 'Ident s when s=n ?? wrong_option_name n; 'String s2 ?? "Syntax error: string expected after opion -"^n>] -> s2
+| [<'Symbol "-"; 'Symbol s when s=n ?? wrong_option_name n; 'String s2 ?? "Syntax error: string expected after opion -"^n>] -> s2
 | [<>] -> default
 
 
 let rec parse_prop spec = parser
   | [<q = parse_term spec; f = parse_suite spec>] -> f q
 and parse_suite spec = parser
-  | [<'Token.Ident s when s = spec.o; q = parse_prop spec ?? wrong_prop spec s>] -> (fun q' -> spec.disj q' q)
+  | [<'Tokens.Symbol s when s = spec.o; q = parse_prop spec ?? wrong_prop spec s>] -> (fun q' -> spec.disj q' q)
   | [<>] -> (fun q' -> q')
 and parse_term spec = parser
   | [<q = parse_fact spec; f = parse_term_suite spec>] -> f q
 and parse_term_suite spec = parser
-    [<'Token.Ident s when s = spec.a; q = parse_term spec ?? wrong_term spec s>] -> (fun q' -> spec.conj q' q)
-  | [<'Token.Ident s when s = spec.an; q = parse_fact spec ?? wrong_fact spec s>] -> (fun q' -> spec.conj q' (spec.neg q))
+    [<'Tokens.Symbol s when s = spec.a; q = parse_term spec ?? wrong_term spec s>] -> (fun q' -> spec.conj q' q)
+  | [<'Tokens.Symbol s when s = spec.an; q = parse_fact spec ?? wrong_fact spec s>] -> (fun q' -> spec.conj q' (spec.neg q))
   | [<>] -> (fun q' -> q')
 and parse_fact spec = parser
-  | [<'Token.LeftPar; q = parse_prop spec ?? wrong_prop spec "("; 'Token.RightPar ?? "Syntax error: missing ')' after proposition">] -> q
-  | [<'Token.Ident s when s = spec.all >] -> spec.taut
-  | [<'Token.Ident s when s = spec.none>] -> spec.cont
-  | [<'Token.Ident s when s = spec.n; q = parse_fact spec ?? wrong_fact spec s>] -> spec.neg q
+  | [<'Tokens.LeftPar; q = parse_prop spec ?? wrong_prop spec "("; 'Tokens.RightPar ?? "Syntax error: missing ')' after proposition">] -> q
+  | [<'Tokens.Symbol s when s = spec.all >] -> spec.taut
+  | [<'Tokens.Symbol s when s = spec.none>] -> spec.cont
+  | [<'Tokens.Symbol s when s = spec.n; q = parse_fact spec ?? wrong_fact spec s>] -> spec.neg q
   | [<a = spec.atom>] -> a
 
 (* generic functions about strings *)