/* -*- 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 Linear constraints of level 0 *)")

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

import "scalar.idl";
import "interval.idl";
import "coeff.idl";
import "dim.idl";
import "linexpr0.idl";

/* For ap_lincons0_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_lincons0_ml2c(value v,ap_lincons0_t* cons, camlidl_ctx _ctx)\n\
{\n\
  value _v_linexpr0;\n\
  value _v_constyp;\n\
  value _v_scalar;\n\
\n\
  _v_linexpr0 = Field(v,0);\n\
  camlidl_apron_linexpr0_ptr_ml2c(_v_linexpr0,&cons->linexpr0);\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_lincons0_c2ml(ap_lincons0_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_linexpr0_ptr_c2ml(&cons->linexpr0);\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 linexpr0 : Linexpr0.t;\n  mutable typ : typ;\n}"),
	 abstract,
	 ml2c(camlidl_apron_lincons0_ml2c),
	 c2ml(camlidl_apron_lincons0_c2ml)]
struct ap_lincons0_t ap_lincons0_t;
quote(MLMLI,"and typ =\n  | EQ\n  | SUPEQ\n  | SUP\n  | DISEQ\n  | EQMOD of Scalar.t\n")

struct ap_lincons0_array_t {
  [size_is(size)] ap_lincons0_t* p;
  int size;
};

quote(MLI,"\n\
(** Make a linear constraint. Modifying later the linear expression\n\
  modifies correspondingly the linear constraint and conversely *)\n\
val make : Linexpr0.t -> typ -> t\n\
\n\
(** Copy a linear 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 = function\n\
| EQ | EQMOD _ -> \"=\"\n\
| SUPEQ -> \">=\"\n\
| SUP -> \">\"\n\
| DISEQ -> \"<>\"\n\
\n\
let print assoc fmt cons = \n\
  Linexpr0.print assoc fmt cons.linexpr0;\n\
  Format.fprintf fmt \"%s0\" (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\
linexpr0 = expr; typ = typ \n\
}\n\
let copy cons = {\n\
linexpr0 = Linexpr0.copy cons.linexpr0; typ = cons.typ\n\
}\n\
")
