(*
 * Some Ocaml documentation is here:
 * http://caml.inria.fr/pub/docs/manual-ocaml/manual023.html
 *
 * Start Ocaml
 * #use "cnf.ml";;
 *
 * Now try this command (and others similar to it):
 *
 *
 * f1;;
 * gencnf f1 1 [];;
 * (gencnf(f1) 1 []).cnf;;
 * List.length (gencnf(f1) 1 []).cnf;;
 *
 * ...
 *
 * f5;;
 * gencnf f5 1 [];;
 * (gencnf(f5) 1 []).cnf;;
 * List.length (gencnf(f5) 1 []).cnf;;
 *)

 (* A CNF generator - the naive exponential-length version *)
 
type literal = int         (* 1, 3, -2, etc          *)
type clause = literal list (* [1; 3; -2]  ->  [ ] means TRUE and [ [ ] ] means FALSE *)
type cnffmla = clause list (* [[1; 3; -2]; [1; -1]] -> (x1 \/ x3 \/ ~x2)/\(x1 \/ ~x1)*)

type fmla =
    Ff  | Tt  | Pv of string      | And of fmla * fmla | Or  of fmla * fmla
              | Eq of fmla * fmla | Imp of fmla * fmla | Not of fmla

type cnf_str = {cnf:cnffmla;                (* CNF formula as a list *)
                nvgen:int;                  (* Variable allocation index *)
                algen: (string * int) list} (* Association list between variable-names
                                               and integers representing them  *)
let rec gencnf(fmla)(next_var_int)(var_al) =  
  match fmla with
      Tt    -> {cnf=[  ]; nvgen=0; algen=[]} 
    | Ff    -> {cnf=[[]]; nvgen=0; algen=[]} 
    | Pv(s) ->
        if (List.mem_assoc s var_al)
        then {cnf = [ [ (List.assoc s var_al) ] ]; 
              nvgen = 0; algen = []}
        else {cnf = [ [ next_var_int ] ]; nvgen = 1; (* 1 new var generated *)
              algen = [(s,next_var_int)]}
          
    | And(q1,q2) ->
        let {cnf=cnf1; nvgen=nvgen1; algen=algen1}
          = gencnf(q1)(next_var_int)(var_al) in
        let {cnf=cnf2; nvgen=nvgen2; algen=algen2}
          = gencnf(q2)(next_var_int + nvgen1)(algen1 @ var_al) in
      {cnf=doAnd(cnf1)(cnf2); nvgen=nvgen1+nvgen2; 
       algen=algen1 @ algen2}
          
    | Or(q1,q2) ->
        let {cnf=cnf1; nvgen=nvgen1; algen=algen1}
          = gencnf(q1)(next_var_int)(var_al) in
        let {cnf=cnf2; nvgen=nvgen2; algen=algen2} 
          = gencnf(q2)(next_var_int + nvgen1)(algen1 @ var_al) in
      {cnf=doOr(cnf1)(cnf2); nvgen=nvgen1+nvgen2; 
       algen=algen1 @ algen2}

    | Imp(q1,q2) -> gencnf(Or(Not(q1),q2))(next_var_int)(var_al)
    | Eq(q1,q2)  -> gencnf(And(Or(Not(q1),q2), Or(Not(q2),q1)))(next_var_int)(var_al)
    | Not(Pv(s)) ->
        if (List.mem_assoc s var_al)
        then {cnf = [ [ (0-(List.assoc s var_al)) ] ];
              nvgen = 0; algen = []}
        else {cnf = [ [ (0-next_var_int) ] ]; nvgen = 1;  (* 1 new var generated *)
               algen = [(s,next_var_int)]}
    | Not(q1) -> 
        let {cnf=cnf1; nvgen=nvgen1; algen=algen1}
          = gencnf(q1)(next_var_int)(var_al) in 
          {cnf=doNot(cnf1); nvgen=nvgen1; 
           algen=algen1}

and                
  doAnd(cnf1)(cnf2) =
  (match (cnf1,cnf2) with
     | ([],cnf2')      -> cnf2'
     | (cnf1',[])      -> cnf1'
     | ([[]],_)        -> [[]]
     | (_,[[]])        -> [[]]
     | _               -> List.append(cnf1)(cnf2) )

and
  doOr(cnf1)(cnf2) = 
    (match (cnf1,cnf2) with
       | ([],_)          -> []
       | (_,[])          -> []
       | ([[]],cnf2')    -> cnf2'
       | (cnf1',[[]])    -> cnf1'
       | ([cl1],[cl2])   -> [List.append(cl1)(cl2)]
       | (cnf1',[cl2])   -> doOr([cl2])(cnf1')
       | (cnf1', (cl2::cls)) ->
           let door1 = doOr(cnf1')([cl2]) in
           let door2 = doOr(cnf1')(cls) in
             doAnd(door1)(door2) )
and
  doNot(cnf1) =
  (match cnf1 with
     | []   -> [[]]
     | [[]] -> []
     | (cl1::cls) ->
         let compclause = comp_clause(cl1) in
         let donot' = doNot(cls) in
           doOr(compclause)(donot') )
and
  comp_clause(clause) =
  (match clause with
     | []          -> []
     | (lit::lits) ->
         let cl = 0-lit in                 (* complement literal *)
         let cl_cnf = [[cl]] in            (* turn literal into CNF *)
         let rest = comp_clause(lits) in
           doAnd(cl_cnf)(rest) )
;;

let f1 = And(And(Pv "x", Pv "y"), And(Pv "z", Pv "w"));;
let f2 = And(And(Pv "p", Pv "q"), And(Pv "r", Pv "s"));;
let f3 = Or(f1,f2);;
let f4 = Or(f3,f3);;
let f5 = Or(f4,f4);;

(*-- end --*)