Source file vector.ml

(* File generated from vector.idl *)

type t
and dimsup = Polka.dimsup

external make : int -> t
	= "camlidl_vector_vector_make"

let dummy = make 0
external copy : t -> t
	= "camlidl_vector_vector_copy"

external _print : t -> unit
	= "camlidl_vector_vector__print"

external get : t -> int -> int
	= "camlidl_vector_vector_get"

external get_str10 : t -> int -> string
	= "camlidl_vector_vector_get_str10"

external set : t -> int -> int -> unit
	= "camlidl_vector_vector_set"

external set_str10 : t -> int -> string -> unit
	= "camlidl_vector_vector_set_str10"

external length : t -> int
	= "camlidl_vector_vector_length"

external compare : t -> t -> int
	= "camlidl_vector_vector_compare"

external compare_expr : t -> t -> int
	= "camlidl_vector_vector_compare_expr"

external hash : t -> int
	= "camlidl_vector_vector_hash"

external product : t -> t -> int
	= "camlidl_vector_vector_product"

external product_strict : t -> t -> int
	= "camlidl_vector_vector_product_strict"

external norm : t -> unit
	= "camlidl_vector_vector_norm"

external norm_expr : t -> unit
	= "camlidl_vector_vector_norm_expr"

external add_expr : t -> t -> t
	= "camlidl_vector_vector_add_expr"

external sub_expr : t -> t -> t
	= "camlidl_vector_vector_sub_expr"

external scale_expr : int -> int -> t -> t
	= "camlidl_vector_vector_scale_expr"

external add_dims : int -> t -> t
	= "camlidl_vector_vector_add_dims"

external add_dims_multi : t -> dimsup array -> t
	= "camlidl_vector_vector_add_dims_multi"

external del_dims_multi : t -> dimsup array -> t
	= "camlidl_vector_vector_del_dims_multi"

external add_permute_dims : t -> int -> int array -> t
	= "camlidl_vector_vector_add_permute_dims"

external permute_del_dims : t -> int -> int array -> t
	= "camlidl_vector_vector_permute_del_dims"

external is_positivity_constraint : t -> bool
	= "camlidl_vector_vector_is_positivity_constraint"

external is_strictness_constraint : t -> bool
	= "camlidl_vector_vector_is_strictness_constraint"

external is_dummy_constraint : t -> bool
	= "camlidl_vector_vector_is_dummy_constraint"

 
let get_big_int vec i = 
try Big_int.big_int_of_int (get vec i) 
with Polka.Overflow(s) -> Big_int.big_int_of_string s 
let set_big_int vec i v = 
if Big_int.is_int_big_int v 
then set vec i (Big_int.int_of_big_int v) 
else set_str10 vec i (Big_int.string_of_big_int v) 
let to_constraint assoc vec = 
Polka.to_constraint assoc (get_big_int vec) (length vec) 
let to_frame assoc vec = 
Polka.to_frame assoc (get_big_int vec) (length vec) 
let to_expr assoc vec = 
Polka.to_expr assoc (get_big_int vec) (length vec) 

let print formatter vec = 
let length = length vec in 
Format.fprintf formatter "@[<h 6>"; 
for i=0 to length-1 do 
Format.fprintf formatter "@<6>%i@ " (get vec i) 
done; 
Format.fprintf formatter "@]"; 
() 
let print_constraint assoc formatter vec = 
Format.pp_print_string formatter (to_constraint assoc vec) 
let print_frame assoc formatter vec = 
Format.pp_print_string formatter (to_frame assoc vec) 
let print_expr assoc formatter vec = 
Format.pp_print_string formatter (to_expr assoc vec) 

let of_constraint assoc dim str = 
let (cons,list) = 
try 
let lexbuf = Lexing.from_string str in 
try Polka_parser.constrain Polka_lexer.lex lexbuf 
with Parsing.Parse_error -> 
failwith 
(Format.sprintf 
"Syntaxical error, characters %d-%d in constraint %s" 
(Lexing.lexeme_start lexbuf) 
(Lexing.lexeme_end lexbuf) 
str) 
with Polka_lexer.Error (s,e) -> 
failwith 
(Format.sprintf 
"Lexical error, characters %d-%d in constraint %s" 
s e str) 
in 
let denominator = Polka.denominator_of_list list in 
let vec = make (!Polka.dec + dim) in 
begin match cons with 
| Polka.Sup -> 
set vec 0 1; 
if !Polka.strict then 
set vec 2 (-1) 
else 
failwith "Vector.of_constraint: strict inequalities not possible with the linked polyhedra library !" 
| Polka.SupEgal -> 
set vec 0 1; 
| Polka.Egal -> 
() 
end; 
let l = ref list in 
while !l<>[] do 
let (n,d,v) = List.hd !l in 
let rank = (if v="" then 1 else !Polka.dec + (assoc v)) in 
let coeff = get_big_int vec rank in 
set_big_int vec rank 
(Big_int.add_big_int 
coeff 
(Big_int.mult_big_int 
n 
(Big_int.div_big_int denominator d))); 
l := List.tl !l 
done; 
norm vec; 
vec 

let of_frame assoc dim str = 
let (gen,list) = 
try 
let lexbuf = Lexing.from_string str in 
try Polka_parser.frame Polka_lexer.lex lexbuf 
with Parsing.Parse_error -> 
failwith 
(Format.sprintf 
"Syntaxical error, characters %d-%d in generator %s" 
(Lexing.lexeme_start lexbuf) 
(Lexing.lexeme_end lexbuf) 
str) 
with Polka_lexer.Error (s,e) -> 
failwith 
(Format.sprintf 
"Lexical error, characters %d-%d in generator %s" 
s e str) 
in 
let denominator = Polka.denominator_of_list list in 
let vec = make (!Polka.dec + dim) in 
set vec 0 (if gen = Polka.Line then 0 else 1); 
set_big_int vec 1 (if gen = Polka.Vertex then denominator else Big_int.zero_big_int); 
let l = ref list in 
while !l<>[] do 
let (n,d,v) = List.hd !l in 
if v="" && (Big_int.sign_big_int n)<>0 then failwith ("Constant has no sense in generator "^str); 
let rank = !Polka.dec + (assoc v) in 
let coeff = get_big_int vec rank in 
set_big_int vec rank 
(Big_int.add_big_int 
coeff 
(Big_int.mult_big_int 
n 
(Big_int.div_big_int denominator d))); 
l := List.tl !l 
done; 
norm vec; 
vec 

let of_expr assoc dim str = 
let list = 
try 
let lexbuf = Lexing.from_string str in 
try Polka_parser.expression Polka_lexer.lex lexbuf 
with Parsing.Parse_error -> 
failwith 
(Format.sprintf 
"Syntaxical error, characters %d-%d in expression %s" 
(Lexing.lexeme_start lexbuf) 
(Lexing.lexeme_end lexbuf) 
str) 
with Polka_lexer.Error (s,e) -> 
failwith 
(Format.sprintf 
"Lexical error, characters %d-%d in expression %s" 
s e str) 
in 
let denominator = Polka.denominator_of_list list in 
let vec = make (!Polka.dec + dim) in 
set_big_int vec 0 denominator; 
let l = ref list in 
while !l<>[] do 
let (n,d,v) = List.hd !l in 
let rank = (if v="" then 1 else !Polka.dec + (assoc v)) in 
let coeff = get_big_int vec rank in 
set_big_int vec rank 
(Big_int.add_big_int 
coeff 
(Big_int.mult_big_int 
n 
(Big_int.div_big_int denominator d))); 
l := List.tl !l 
done; 
norm_expr vec; 
vec