(* Copyright 2005-2007 Berke DURAK, INRIA Rocquencourt.

This file is part of Dose2.

Dose2 is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Dose2 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>. *)

type 'a product = P of 'a * 'a product list;;
(*** factorize *)
let rec factorize : 'a list list -> 'a product list =
  fun l ->
  let l = List.sort compare l in
  let (result,state) =
    List.fold_left
      begin fun (result,state) term ->
        match term with
        | head :: rest ->
          begin
            match state with
            | None -> (result,Some(head,[rest]))
            | Some(head', rests) ->
              if head = head' then
                (result,Some(head', rest :: rests))
              else
                (P(head', factorize rests) :: result, Some(head, [rest]))
          end
        | _ -> (result,state)
      end
      ([],None)
      l
  in
  match state with
  | None -> result
  | Some(head, rests) -> P(head, factorize rests) :: result
;;
(* ***)
(*** print_product, print_product_list *)
let rec print_product print_element oc = function
| P(x,[]) -> print_element oc x
| P(x,[p]) ->
    Printf.fprintf oc "%a" print_element x;
    print_product print_element oc p
| P(x,l) ->
    Printf.fprintf oc "%a(" print_element x;
    print_product_list print_element oc l;
    Printf.fprintf oc ")"
and print_product_list print_element oc l =
  let first = ref true in
  List.iter
    begin fun y ->
      if !first then first := false else Printf.fprintf oc " + ";
      print_product print_element oc y
    end
    l
;;
(* ***)
(*** encode_product_list *)
let encode_product_list element pl =
  let b = Buffer.create 256 in
  let rec product = function
  | P(x,[]) -> element b x
  | P(x,[p]) ->
      Printf.bprintf b "%a." element x;
      product p
  | P(x,l) ->
      Printf.bprintf b "%a(" element x;
      product_list l;
      Printf.bprintf b ")"
  and product_list l =
    let first = ref true in
    List.iter
      begin fun y ->
        if !first then first := false else Printf.bprintf b "+";
        product y
      end
      l
  in
  product_list pl;
  Buffer.contents b
;;
(* ***)
