/* -*- mode: c -*- */

/* This file is part of the APRON Library, released under LGPL license.
   Please read the COPYING file packaged in the distribution  */

quote(MLI,"(** APRON tree expressions constraints of level 0 *)")

quote(C, "\n\
#include <limits.h>\n\
#include \"ap_lincons0.h\"\n\
#include \"ap_texpr0.h\"\n\
#include \"apron_caml.h\"\n\
\n\
")

import "scalar.idl";
import "interval.idl";
import "coeff.idl";
import "dim.idl";
import "lincons0.idl";
import "texpr0.idl";

/* For ap_tcons0_t, 

- the conversion from ML to C may use allocation, but it is automatically freed 
  by Camlidl mechanisms
- the conversion from C to ML free after conversion the scalar field in the C structure.
  the C type should NOT be deallocated
*/

quote(C,"\n\
void camlidl_apron_tcons0_ml2c(value v,ap_tcons0_t* cons, camlidl_ctx _ctx)\n\
{\n\
  value _v_texpr0;\n\
  value _v_constyp;\n\
  value _v_scalar;\n\
\n\
  _v_texpr0 = Field(v,0);\n\
  camlidl_apron_texpr0_ptr_ml2c(_v_texpr0,&cons->texpr0);\n\
  _v_constyp = Field(v,1);\n\
  if (Is_long(_v_constyp)){\n\
    switch (Int_val(_v_constyp)){
    case 0:\n\
    case 1:\n\
    case 2:\n\
      cons->constyp = Int_val(_v_constyp);\n\
      break;\n\
    case 3:\n\
      cons->constyp = 4;\n\
      break;\n\
    default:\n\
     abort();\n\
    }\n\
    cons->scalar = NULL;\n\
  }\n\
  else {\n\
    switch (Tag_val(_v_constyp)){\n\
    case 0:\n\
      cons->constyp = AP_CONS_EQMOD;\n\
      _v_scalar = Field(_v_constyp,0);\n\
      cons->scalar = (ap_scalar_t *)camlidl_malloc(sizeof(ap_scalar_t),_ctx);\n\
      camlidl_apron_scalar_ml2c(_v_scalar,cons->scalar);\n\
      break;\n\
    default:\n\
      abort();\n\
    }\n\
  }\n\
}\n\
value camlidl_apron_tcons0_c2ml(ap_tcons0_t* cons)\n\
{\n\
  value vres;\n\
  value _v[3];\n\
  _v[0] = _v[1] = _v[2] = 0;\n\
\n\
  Begin_roots_block(_v, 3)\n\
    _v[0] = camlidl_apron_texpr0_ptr_c2ml(&cons->texpr0);\n\
    switch(cons->constyp){\n\
    case AP_CONS_EQ:\n\
    case AP_CONS_SUPEQ:\n\
    case AP_CONS_SUP:\n\
      _v[1] = Val_int(cons->constyp);\n\
      break;\n\
    case AP_CONS_DISEQ:\n\
      _v[1] = Val_int(3);\n\
      break;\n\
    case AP_CONS_EQMOD:\n\
      assert(cons->scalar!=NULL);\n\
      _v[2] = camlidl_apron_scalar_c2ml(cons->scalar);\n\
      _v[1] = camlidl_alloc_small(1, 0);\n\
      Field(_v[1],0) = _v[2];\n\
      ap_scalar_free(cons->scalar); cons->scalar = NULL;\n\
      break;\n\
    }\n\
    vres = camlidl_alloc_small(2, 0);\n\
    Field(vres, 0) = _v[0];\n\
    Field(vres, 1) = _v[1];\n\
  End_roots()\n\
  return vres;\n\
}\n\
")


typedef [mltype("{\n  mutable texpr0 : Texpr0.t;\n  mutable typ : Lincons0.typ;\n}"),
	 abstract,
	 ml2c(camlidl_apron_tcons0_ml2c),
	 c2ml(camlidl_apron_tcons0_c2ml)]
struct ap_tcons0_t ap_tcons0_t;
quote(MLMLI,"\n\
type typ = Lincons0.typ =\n\
  | EQ\n\
  | SUPEQ\n\
  | SUP\n\
  | DISEQ\n\
  | EQMOD of Scalar.t\n\
")

struct ap_tcons0_array_t {
  [size_is(size)] ap_tcons0_t* p;
  int size;
};

quote(MLI,"\n\
(** Make a tree expression constraint. Modifying later the tree expression expression\n\
  modifies correspondingly the tree expression constraint and conversely *)\n\
val make : Texpr0.t -> typ -> t\n\
\n\
(** Copy a tree expression constraint (deep copy) *)\n\
val copy : t -> t\n\
\n\
(** Convert a constraint type to a string ([=],[>=], or [>]) *)\n\
val string_of_typ : typ -> string\n\
\n\
(** Print a constraint *)\n\
val print : (Dim.t -> string) -> Format.formatter -> t -> unit\n\
")

quote(ML,"\n\
let string_of_typ = Lincons0.string_of_typ\n\
\n\
let print assoc fmt cons = \n\
  Texpr0.print assoc fmt cons.texpr0;\n\
  Format.fprintf fmt \" %s 0\" (string_of_typ cons.typ);\n\
  begin match cons.typ with\n\
  | EQMOD x -> Format.fprintf fmt \" mod %a\" Scalar.print x;\n\
  | _ -> ()\n\
  end;\n\
  ()\n\
let make expr typ = {\n\
texpr0 = expr; typ = typ \n\
}\n\
let copy cons = {\n\
texpr0 = Texpr0.copy cons.texpr0; typ = cons.typ\n\
}\n\
")
