with sql_exceptions; package body sql_int_pkg is null_value_error : exception renames sql_exceptions. null_value_error; function without_null_base (value : sql_int) return sql_int_not_null is begin if value. is_null then raise null_value_error; else return value. value; end if; end without_null_base; function with_null_base (value : sql_int_not_null) return sql_int is begin return (false, value); end with_null_base; procedure assign_with_check (left : in out sql_int; right : sql_int; first, last : sql_int_not_null) is begin if right. is_null then left. is_null := true; elsif (right. value < first or else right. value > last) then raise constraint_error; else left := right; end if; end assign_with_check; function null_sql_int return sql_int is null_holder : sql_int; begin return (null_holder); -- relies on default expression for is_null end null_sql_int; function "+" (right : sql_int) return sql_int is begin return right; end "+"; function "-" (right : sql_int) return sql_int is begin return (right. is_null, - (right. value)); end "-"; function "abs" (right : sql_int) return sql_int is begin return (right. is_null, abs (right. value)); end "abs"; function "+" (left, right : sql_int) return sql_int is begin if left. is_null or right. is_null then return null_sql_int; else return (false, (left. value + right. value)); end if; end "+"; function "*" (left, right : sql_int) return sql_int is begin if left. is_null or right. is_null then return null_sql_int; else return (false, (left. value * right. value)); end if; end "*"; function "-" (left, right : sql_int) return sql_int is begin if left. is_null or right. is_null then return null_sql_int; else return (false, (left. value - right. value)); end if; end "-"; function "/" (left, right : sql_int) return sql_int is begin if left. is_null or right. is_null then return null_sql_int; else return (false, (left. value / right. value)); end if; end "/"; function "mod" (left, right : sql_int) return sql_int is begin if left. is_null or right. is_null then return null_sql_int; else return (false, (left. value mod right. value)); end if; end "mod"; function "rem" (left, right : sql_int) return sql_int is begin if left. is_null or right. is_null then return null_sql_int; else return (false, (left. value rem right. value)); end if; end "rem"; function "**" (left : sql_int; right : integer) return sql_int is begin if left. is_null then return null_sql_int; else return (false, (left. value ** right)); end if; end "**"; function image (left : sql_int_not_null) return sql_char_not_null is begin return to_sql_char_not_null (sql_int_not_null'image (left)); end image; function image (left : sql_int) return sql_char is begin if not left. is_null then return to_sql_char (sql_int_not_null'image (left. value)); else return null_sql_char; end if; end image; function value (left : sql_char_not_null) return sql_int_not_null is begin return sql_int_not_null'value (to_string (left)); end value; function value (left : sql_char) return sql_int is begin if not_null (left) then return with_null_base (sql_int_not_null'value (to_string (left))); else return null_sql_int; end if; end value; function equals (left, right : sql_int) return boolean_with_unknown is begin if left. is_null or right. is_null then return unknown; elsif left. value = right. value then return true; else return false; end if; end equals; function not_equals (left, right : sql_int) return boolean_with_unknown is begin if left. is_null or right. is_null then return unknown; elsif left. value = right. value then return false; else return true; end if; end not_equals; function "<" (left, right : sql_int) return boolean_with_unknown is begin if left. is_null or right. is_null then return unknown; elsif left. value < right. value then return true; else return false; end if; end "<"; function ">" (left, right : sql_int) return boolean_with_unknown is begin if left. is_null or right. is_null then return unknown; elsif left. value > right. value then return true; else return false; end if; end ">"; function "<=" (left, right : sql_int) return boolean_with_unknown is begin if left. is_null or right. is_null then return unknown; elsif left. value <= right. value then return true; else return false; end if; end "<="; function ">=" (left, right : sql_int) return boolean_with_unknown is begin if left. is_null or right. is_null then return unknown; elsif left. value >= right. value then return true; else return false; end if; end ">="; function is_null (value : sql_int) return boolean is begin return value. is_null; end; function not_null (value : sql_int) return boolean is begin return not value. is_null; end; function "=" (left, right : sql_int) return boolean is begin if left. is_null or else right. is_null then return false; else return left. value = right. value; end if; end "="; function "<" (left, right : sql_int) return boolean is begin if left. is_null or else right. is_null then return false; else return left. value < right. value; end if; end "<"; function ">" (left, right : sql_int) return boolean is begin if left. is_null or else right. is_null then return false; else return left. value > right. value; end if; end ">"; function "<=" (left, right : sql_int) return boolean is begin if left. is_null or else right. is_null then return false; else return left. value <= right. value; end if; end "<="; function ">=" (left, right : sql_int) return boolean is begin if left. is_null or else right. is_null then return false; else return left. value >= right. value; end if; end ">="; package body sql_int_ops is function with_null (value : without_null_type) return with_null_type is begin return (with_null_base (sql_int_not_null (value))); end with_null; function without_null (value : with_null_type) return without_null_type is begin return (without_null_type (sql_int_not_null'(without_null_base (value)))); end without_null; procedure assign (left : in out with_null_type; right : in with_null_type) is begin assign_with_check (left, right, sql_int_not_null (without_null_type'first), sql_int_not_null (without_null_type'last)); end assign; end; end;