helm/ocaml/mathql_interpreter/union.ml

   1
   2 (*
   3  * implementazione del comando UNION
   4  *)
   5
   6 (*
   7  *
   8  *)
   9 let xres_fill_context hr h1 l1 =
  10  match l1 with
  11     [] -> []
  12  |   _ ->
  13      let hh = List.combine h1 l1
  14      in
  15       List.map
  16        (fun x ->
  17         if (List.mem_assoc x hh) then
  18          List.assoc x hh
  19         else
  20          ""
  21        )
  22        hr
  23 ;;
  24
  25 (*
  26  * implementazione del comando UNION
  27  *)
  28 let union_ex alist1 alist2 =
  29  let head1 = List.hd alist1
  30  and tail1 = List.tl alist1
  31  and head2 = List.hd alist2
  32  and tail2 = List.tl alist2 (* e fin qui ... *)
  33  in
  34   match (head1, head2) with
  35      ([], _) -> assert false (* gli header non devono mai essere vuoti *)
  36   |  (_, []) -> assert false (* devono contenere almeno [retVal] *)
  37   |  (_,  _) -> let headr = (head2 @
  38                             (List.find_all
  39                              (function t -> not (List.mem t head2))
  40                              head1)
  41                             ) in (* header del risultato finale *)
  42       List.append (* il risultato finale e' la concatenazione ...*)
  43        [headr] (* ... dell'header costruito prima ...*)
  44        (match (tail1, tail2) with (* e di una coda "unione" *)
  45            ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *)
  46         |  (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *)
  47         |  (_,  _) ->
  48             let first = (* parte dell'unione che riguarda solo il primo set *)
  49              List.map (fun l -> [List.hd l] @
  50                        xres_fill_context
  51                         (List.tl headr) (List.tl head1) (List.tl l)
  52                       ) tail1
  53             in
  54              List.fold_left
  55               (fun par x ->
  56                let y = (* elemento candidato ad entrare *)
  57                 [List.hd x]
  58                 @
  59                 xres_fill_context
  60                  (List.tl headr) (List.tl head2) (List.tl x)
  61                in
  62                 par @ if (List.find_all (fun t -> t = y) par) = [] then
  63                        [y]
  64                       else
  65                        []
  66               )
  67               first
  68               tail2
  69 (*           first @
  70              List.map (fun l -> [List.hd l] @
  71                        xres_fill_context
  72                         (List.tl headr) (List.tl head2) (List.tl l)
  73                       ) tail2
  74 *)
  75        ) (* match *)
  76 ;;
  77
  78 (** TEST **)
  79
  80 (*
  81 let h1 = ["retVal";     "a";      "b"];;
  82 let l1 = ["pippo";      "3";      "3"];;
  83 let l3 = ["pluto";      "7";      "8"]
  84 let r1 = [h1; l1; l3];;
  85
  86 (*let h2 = ["retVal";               "b";      "c"];;
  87 let l2 = ["pippo";                "3";      "1"];;*)
  88 let h2 = ["retVal";     "a";      "b"];;
  89 let l2 = ["pippo";      "3";      "3"];;
  90 let r2 = [h2; l2];;
  91
  92 List.map (fun l -> List.iter print_endline l) (xres_union (r1, r2));;
  93 *)