<commit_before>(*
 * Copyright (c) 2010-2011 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Camlp4.PreCast

let expr_list_of_list _loc exprs =
  match List.rev exprs with
  | []   -> <:expr< [] >>
  | h::t ->
    List.fold_left (fun accu x -> <:expr< [ $x$ :: $accu$ ] >>) <:expr< [ $h$ ] >> t

let xml_of t = "xml_of_" ^ t

let c = ref 0

let new_id _loc _ =
  incr c;
  let v = "var" ^ string_of_int !c in
  <:patt< $lid:v$ >>, <:expr< $lid:v$ >>
;;

let xml_type _loc id =
  if !Options.needsopen then
    <:ctyp< Cow.Xml.$lid:id$ >>
  else
    <:ctyp< Xml.$lid:id$ >>

let create_tag _loc n body =
  let typ = xml_type _loc "tag" in
  let tag = <:expr< ((("",$`str:n$), []) : $typ$)>> in
  <:expr< match $body$ with [ [] -> [] | _ -> [`El $tag$ $body$] ] >>

let gen_xml (_loc, n, (t_exp:Dyntype.Type.t)) =
  let open Dyntype.Type in
  let t = match t_exp with Ext (_,t) | Rec (_,t) -> t | _ -> assert false in
  let rec aux id = function
    | Unit     -> <:expr< >>
    | Bool     -> <:expr< [`Data (string_of_bool $id$)] >>
    | Float    -> <:expr< [`Data (string_of_float $id$)] >>
    | Char     -> <:expr< [`Data (String.make 1 $id$)] >>
    | String   -> <:expr< [`Data $id$] >>
    | Int (Some i) when i <= 64 ->
      if i + 1 = Sys.word_size then
        <:expr< [`Data (string_of_int $id$)] >>
      else if i <= 32 then
        <:expr< [`Data (Int32.to_string $id$)] >>
      else
        <:expr< [`Data (Int64.to_string $id$)] >>
    | Int _ ->
      <:expr< [`Data (Bigint.to_string $id$)] >>
    | List t   ->
      let pid, eid = new_id _loc () in
      <:expr< List.fold_left (fun accu $pid$ -> $aux eid t$ @ accu) [] $id$ >>
    | Array t  ->
      let pid, eid = new_id _loc () in
      let array = <:expr< Array.map (fun $pid$ -> $aux eid t$) $id$ >> in
      <:expr< List.flatten (Array.to_list $array$) >>
    | Tuple t  ->
      let ids = List.map (new_id _loc) t in
      let patts,exprs = List.split ids in
      let exprs = List.map2 aux exprs t in
      <:expr<
        let $Pa_dyntype.P4_helpers.patt_tuple_of_list _loc patts$ = $id$ in
        List.flatten $expr_list_of_list _loc exprs$
        >>
    | Dict(k,d) ->
      let new_id n = match k with
        | `R -> <:expr< $id$.$lid:n$ >>
        | `O -> <:expr< $id$#$lid:n$ >> in
      let exprs =
        List.map (fun (n,_,t) -> create_tag _loc n (aux (new_id n) t)) d in
      let expr = expr_list_of_list _loc exprs in
      <:expr< List.flatten $expr$ >>
    | Sum (k, s) ->
      let mc (n, args) =
        let ids = List.map (new_id _loc) args in
        let patts, exprs = List.split ids in
        let exprs = match args with<commit_msg>Fix order of elements in the generated xml list<commit_after>(*
 * Copyright (c) 2010-2011 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Camlp4.PreCast

let expr_list_of_list _loc exprs =
  match List.rev exprs with
  | []   -> <:expr< [] >>
  | h::t ->
    List.fold_left (fun accu x -> <:expr< [ $x$ :: $accu$ ] >>) <:expr< [ $h$ ] >> t

let xml_of t = "xml_of_" ^ t

let c = ref 0

let new_id _loc _ =
  incr c;
  let v = "var" ^ string_of_int !c in
  <:patt< $lid:v$ >>, <:expr< $lid:v$ >>
;;

let xml_type _loc id =
  if !Options.needsopen then
    <:ctyp< Cow.Xml.$lid:id$ >>
  else
    <:ctyp< Xml.$lid:id$ >>

let create_tag _loc n body =
  let typ = xml_type _loc "tag" in
  let tag = <:expr< ((("",$`str:n$), []) : $typ$)>> in
  <:expr< match $body$ with [ [] -> [] | _ -> [`El $tag$ $body$] ] >>

let gen_xml (_loc, n, (t_exp:Dyntype.Type.t)) =
  let open Dyntype.Type in
  let t = match t_exp with Ext (_,t) | Rec (_,t) -> t | _ -> assert false in
  let rec aux id = function
    | Unit     -> <:expr< >>
    | Bool     -> <:expr< [`Data (string_of_bool $id$)] >>
    | Float    -> <:expr< [`Data (string_of_float $id$)] >>
    | Char     -> <:expr< [`Data (String.make 1 $id$)] >>
    | String   -> <:expr< [`Data $id$] >>
    | Int (Some i) when i <= 64 ->
      if i + 1 = Sys.word_size then
        <:expr< [`Data (string_of_int $id$)] >>
      else if i <= 32 then
        <:expr< [`Data (Int32.to_string $id$)] >>
      else
        <:expr< [`Data (Int64.to_string $id$)] >>
    | Int _ ->
      <:expr< [`Data (Bigint.to_string $id$)] >>
    | List t   ->
      let pid, eid = new_id _loc () in
      <:expr< List.rev (List.fold_left (fun accu $pid$ -> $aux eid t$ @ accu) [] $id$) >>
    | Array t  ->
      let pid, eid = new_id _loc () in
      let array = <:expr< Array.map (fun $pid$ -> $aux eid t$) $id$ >> in
      <:expr< List.flatten (Array.to_list $array$) >>
    | Tuple t  ->
      let ids = List.map (new_id _loc) t in
      let patts,exprs = List.split ids in
      let exprs = List.map2 aux exprs t in
      <:expr<
        let $Pa_dyntype.P4_helpers.patt_tuple_of_list _loc patts$ = $id$ in
        List.flatten $expr_list_of_list _loc exprs$
        >>
    | Dict(k,d) ->
      let new_id n = match k with
        | `R -> <:expr< $id$.$lid:n$ >>
        | `O -> <:expr< $id$#$lid:n$ >> in
      let exprs =
        List.map (fun (n,_,t) -> create_tag _loc n (aux (new_id n) t)) d in
      let expr = expr_list_of_list _loc exprs in
      <:expr< List.flatten $expr$ >>
    | Sum (k, s) ->
      let mc (n, args) =
        let ids = List.map (new_id _loc) args in
        let patts, exprs = List.split ids in
        let exprs = match args with
{'fraction_non_alphanumeric': 0.1557997920689143, 'fraction_numerical': 0.00653497697905837, 'mean_word_length': 2.538623226484498, 'pattern_counts': {'":': 0, '<': 113, '<?xml version=': 0, '>': 157, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 11}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7213729', 'n_tokens_mistral': 2551, 'n_tokens_neox': 2460, 'n_words': 842}