Commits

Sébastien Ferré committed f09e26c

Add of 'length' and parsing of options.

Comments (0)

Files changed (1)

 (* forbidden idents in syntax of logics *)
 let keywords = ["and";"or";"not"]
 
+let rec length = function
+  | [] -> 0
+  | x::xs ->
+      match x with
+      | PP_tilda | PP_space | PP_cut | PP_break _ | PP_newline -> length xs
+      | _ -> 1 + length xs
+
 let rec get_terms : t_list -> string list =
   function
       [] -> []
     Stream.from (fun _ ->
       try Some (Lexer.token lexbuf)
       with Eof -> None)
-(*
-	try match Lexer.token lexbuf with
-	  EOL -> None
-	| tok -> Some tok
-	with Eof -> None)
-*)
 
 let from_string : string -> t_stream =
   fun s ->
       try Some (Lexer.token lexbuf)
       with Eof -> None)
 
-let rec list_of_stream : t_stream -> t_list = parser
-    [<'tok; toks = list_of_stream>] -> tok::toks
-  | [<>] -> []
+let rec list_of_stream s =
+  try
+    let x = Stream.next s in
+    x::list_of_stream s
+  with _ -> []
 
 let rec of_list : t_list -> t_stream =
   fun toks -> Stream.of_list
 (* get the string representation of the token *)
 type space_of_token = Sep | PonctL | PonctR | Op | Word
 
-(*
-let string_of_token : Token.t -> string * space_of_token =
-  function
-    | EOL -> "\n", Sep
-    | BackQuote -> "`", Sep
-    | Tilda -> "~", Sep
-    | Exclam -> "!", PonctR
-    | At -> "@", Sep
-    | Sharp -> "#", Sep
-    | Dollar -> "$", Sep
-    | Percent -> "%", Sep
-    | Hat -> "^", Op
-    | Et -> "&", Op
-    | Star -> "*", Op
-    | LeftPar -> "(", PonctL
-    | RightPar -> ")", Sep
-    | Minus -> "-", Op
-    | Plus -> "+", Op
-    | Equal -> "=", Op
-    | LeftAcc -> "{", PonctL
-    | RightAcc -> "}", Sep
-    | LeftBra -> "[", PonctL
-    | RightBra -> "]", Sep
-    | Pipe -> "|", Op
-    | BackSlash -> "\\", Sep
-    | Slash -> "/", Sep
-    | Interro -> "?", PonctR
-    | LT -> "<", Op
-    | GT -> ">", Op
-    | Comma -> ",", PonctR
-    | DotDot -> "..", Sep
-    | Dot -> ".", PonctR
-    | Colon -> ":", PonctR
-    | SemiColon -> ";", PonctR
-    | DoubleQuote -> "\"", Sep
-    | Quote -> "'", Sep
-    | Ident s -> s, Word
-    | Int n -> string_of_int n, Word
-    | Float (f,p) -> string_of_float f, Word
-        let s = string_of_float f in
-        let l = String.length s in
-        let prec = prec_of_sfloat s in
-        if prec >= p
-        then s
-        else
-          let zeros = String.make (p-prec) '0' in
-          try
-            let i_e = String.index s 'e' in
-            String.sub s 0 i_e ^ zeros ^ String.sub s i_e (l-i_e) 
-          with Not_found -> s ^ zeros,
-        Word
-    | String s -> "\"" ^ String.escaped s ^ "\"", Word
-    | Term s ->
-	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 s, Word
-	else "'" ^ String.escaped s ^ "'", Word
-    | Char c -> "`" ^ Char.escaped c ^ "`", Word
-    | PP_tilda -> " ", Sep
-    | PP_space -> " ", Sep
-    | PP_cut -> "", Sep
-    | PP_break (spaces,offset) -> " ", Sep
-
-let rec stringizer : t_list -> string =
-  function
-      [] -> ""
-    | tok::toks ->
-	let buf = Buffer.create 100 in
-	let s, t = string_of_token tok in
-	Buffer.add_string buf s;
-	stringizer2 buf t toks
-and stringizer2 buf t0 = function
-    [] -> Buffer.contents buf
-  | tok::toks ->
-      let s, t = string_of_token tok in
-      ( match t0, t with
-      |	Sep, Word -> ()
-      |	t1, Sep when t1 <> PonctR -> ()
-      |	t1, PonctR when t1 <> PonctR -> ()
-      |	PonctL, t1 when t1 <> PonctL -> ()
-      |	_, _ -> Buffer.add_char buf ' ');
-      Buffer.add_string buf s;
-      stringizer2 buf t toks
-*)
-
 open Format
 
 let rec power10 : int -> float =
     | Star -> pp_print_string ff "*"
     | LeftPar -> pp_print_string ff "("
     | RightPar -> pp_print_string ff ")"
-    | Minus ->
-(*
-	( match pred with
-	| Ident _ | Term _ -> pp_print_string ff " "
-	| _ -> ());
-*)
-	pp_print_string ff "-"
-    | Plus ->
-(*
-	( match pred with
-	| Ident _ | Term _ -> pp_print_string ff " "
-	| _ -> ());
-*)
-	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 "}"
 	pp_print_token ff pred tok;
 	pp_print_tokens2 ff tok toks
 
-(*
-  fun ff -> function
-      [] -> ()
-    | tok::toks ->
-	let s, t = string_of_token tok in
-	Format.pp_print_string ff s;
-	pp_print_tokens2 ff t toks
-and pp_print_tokens2 ff t0 = function
-    [] -> ()
-  | tok::toks ->
-      let s, t = string_of_token tok in
-      ( match t0, t with
-      | Sep, Word -> ()
-      | t1, Sep when t1 <> PonctR -> ()
-      | t1, PonctR when t1 <> PonctR -> ()
-      | PonctL, t1 when t1 <> PonctL -> ()
-      | _, _ -> Format.pp_print_space ff ());
-      Format.pp_print_string ff s;
-      pp_print_tokens2 ff t toks
-*)
-
 let stringizer : t_list -> string =
   fun toks ->
     pp_print_tokens Format.str_formatter toks;
   fun s ->
     pp_print_string Format.std_formatter s 
 
+let print_int : int -> unit =
+  fun n ->
+    pp_print_int Format.std_formatter n
+
 (* fonctions generiques pour le printing *)
 (* ------------------------------------- *)
 
   [<x = p; xs = parse_star p>] -> x::xs
 | [<>] -> []
 
+(* parsing options *)
+
+let parse_option_bool n = parser
+| [<'Minus; 'Ident s when s=n>] -> true
+| [<>] -> false
+
+let parse_option_int ?(default=0) n = parser
+| [<'Minus; 'Ident s when s=n; 'Int i>] -> i
+| [<>] -> default
+
+let parse_option_float ? (default=0.) n = parser
+| [<'Minus; 'Ident s when s=n; 'Float (x,_)>] -> x
+| [<>] -> default
+
+let parse_option_string ?(default="") n = parser
+| [<'Minus; 'Ident s when s=n; 'String s2>] -> s2
+| [<>] -> default
+
+
 (* parsing of proposition-like language, where operations and atoms are parameterized *)
 
 type 'a spec_prop = {