open Naked
open Abstract_syntax_tree

module Constants : NAKED_VALUE_DOMAIN = struct
	type t = Z.t
	let const z = z
	let rand z w = raise NeedTop (* We know rand is never called on singletons *)
	let minus z = Z.neg z
	let binary a b op = match op with
		| AST_PLUS     -> Z.add a b
		| AST_MINUS    -> Z.sub a b
		| AST_MULTIPLY -> Z.mul a b
		| AST_DIVIDE   -> (try(Z.div a b)with Division_by_zero -> raise Absurd)
		| AST_MODULO   -> Z.rem a b

	let is_only_zero z = Z.equal (Z.zero) z
	let multiples_of z = if Z.equal Z.zero z then Z.zero else raise NeedTop
	let divisors_of  z = if Z.equal Z.zero z then Z.zero else raise NeedTop
	let remainders   z = if Z.equal Z.zero z then Z.zero else raise NeedTop
	let convex_sym   z = if Z.equal Z.zero z then Z.zero else raise NeedTop 

	let compatible z op = match op with
		| AST_EQUAL -> z
		| _ -> raise NeedTop
	let compare z w op = match op with
		| AST_EQUAL -> if Z.equal z w then z,w else raise Absurd
		| AST_NOT_EQUAL -> if Z.equal z w then raise Absurd else z,w
		| AST_LESS -> if Z.lt z w then z,w else raise Absurd
		| AST_LESS_EQUAL -> if Z.leq z w then z,w else raise Absurd
		| AST_GREATER -> if Z.gt z w then z,w else raise Absurd
		| AST_GREATER_EQUAL -> if Z.geq z w then z,w else raise Absurd
	let bwd_binary x y op r = if Z.equal (binary x y op) r then x,y else raise Absurd
	let join x y = if Z.equal x y then x else raise NeedTop	
	let meet x y = if Z.equal x y then x else raise Absurd
	let widen x y = if Z.equal x y then x else raise NeedTop
	let narrow x y = if Z.equal x y then x else raise Absurd
	let subset x y = Z.equal x y
	let print out x = Z.pp_print out x 
end