Add suffix in services as an attribute.

types/types.ml

@@ -1824,12 +1824,16 @@ end
 
 module Service =
 struct
+  type service_attributs = {mutable suffix : bool }
   let prepare t = 
     let t = Print.uniq t in
     let t = Print.prepare t in 
     Print.assign_name t;
     t;;
 
+  let trace msg = output_string stderr (msg ^ "\n"); 
+    flush stderr;;
+
   let print_to_string f =
     let b = Buffer.create 1024 in
     let ppf = Format.formatter_of_buffer b in
@@ -1847,12 +1851,12 @@ struct
       | "String" -> TString(name)
       | "Float" -> TFloat(name)
       | "Bool" -> TBool(name)
-      | _ -> TUnit;;
+      | _ -> assert false;;
 
   let rec convert (s : Print.nd) name = 
     match s.Print.state with 
-      | `Named n -> output_string stderr ("debug:convert " ^
-	  (U.to_string n) ^ "\n") ; convert_real name s.Print.def
+      | `Named n -> trace ("debug:convert " ^ (U.to_string n)) ; 
+	  convert_real name s.Print.def
       | `GlobalName n -> get_gtype n name
       | _ -> convert_real name s.Print.def
   and convert_real name def = 
@@ -1869,7 +1873,15 @@ struct
     | Print.Name n -> assert false
     | Print.Char c -> assert false
     | Print.Regexp r -> convert_regexp name r
-    | Print.Xml (tag,attr,t) -> convert t (convert_tag tag)
+    | Print.Xml (tag,attr,t) -> 
+	let flags = { suffix = false } in
+	(convert_attrs flags attr;
+	let res = convert t (convert_tag tag) in
+	if flags.suffix then
+	  TSuffix(true,res)
+	else
+	  res
+	)
     | _ -> assert false
   and convert_regexp name = function
     | Pretty.Seq (r1,r2) -> 
@@ -1885,7 +1897,35 @@ struct
   and convert_tag =
     function 
       | `Tag s -> print_to_string s
-      | `Type t -> assert false;;
+      | `Type t -> assert false
+  and convert_attrs flags = 
+    trace "convert_attrs";
+    function
+      | { Print.state = `Marked|`Expand|`None; 
+	def = [ Print.Record (r,some,none) ] } -> 
+	  convert_record flags (r,some,none)
+      | { Print.state = `Named n; 
+	def = [ Print.Record (r,some,none) ] } -> 
+	  trace ("debug:convert_attrs:Named " 
+	  ^ (U.to_string n)); 
+	  convert_record flags (r,some,none)
+	    (*	  convert_real name s.Print.def *)
+	    (*      | `GlobalName n -> get_gtype n name *)
+      | _ -> trace "convert_attrs:_"; ()
+  and convert_record flags (r,some,none) =
+    List.iter
+      (fun (l,(o,t)) ->
+	(*	let opt = if o then "?" else "" in *)
+	let attr_label = Label.string_of_attr l in
+	trace ("convert_record:" ^ attr_label);
+	match attr_label with
+	  | "suffix" -> flags.suffix <- true
+	  | _ -> output_string stderr 
+	      ("Bad attribute name:" ^ attr_label ^ "\n")
+	  (*	  Label.print_attr l opt (do_print_slot 0) t *)
+      ) (LabelMap.get r);
+    if not none then output_string stderr " (+others)";
+    if some then output_string stderr " ..";;
 
   let clear () =
     Print.count_name := 0; 
@@ -1899,6 +1939,10 @@ struct
     ret;;
 
   let to_string t =
+    let bool_to_string = function
+      | true -> "true"
+      | false -> "false" 
+    in
     let rec aux = function 
       | TInt n -> "TInt(" ^ n ^ ")"
       | TFloat n -> "TFloat(" ^ n ^ ")"
@@ -1909,6 +1953,7 @@ struct
       | TSet e -> "TSet(" ^ (aux e) ^ ")"
       | TUnit -> "TUnit()"
       | TSum (e1, e2) -> "TSum(" ^ (aux e1) ^ "," ^ (aux e2) ^ ")"
+      | TSuffix (b,e) -> "TSuffix(" ^ (bool_to_string b) ^ "," ^ (aux e) ^ ")"
       | _ -> " unknown "
     in aux t;;
 end