Commit 41e26c72 authored by Jérôme Maloberti's avatar Jérôme Maloberti

Add suffix in services as an attribute.

parent 02ac63de
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment