carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-11 05:25:28 +03:00
Code Issues Projects Releases Wiki Activity

int/long: added safe arithmetic

Browse Source
This commit is contained in:
hellerve 2017-11-16 21:19:39 +01:00
parent c6f1a155da
commit 40c19b138e
4 changed files with 147 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/Int.carp
View File

@ -17,5 +17,9 @@
(register inc (λ [Int] Int))
(register dec (λ [Int] Int))
(register copy (λ [&Int] Int)) ;; TODO: Should not be needed when refs to value types are auto-converted to non-refs.
(register safe-add (λ [Int Int (Ref Int)] Bool))
(register safe-sub (λ [Int Int (Ref Int)] Bool))
(register safe-mul (λ [Int Int (Ref Int)] Bool))
)

4
core/Long.carp
View File

@ -19,4 +19,8 @@
(defn /= [x y]
(not (= x y)))
(register safe-add (λ [Long Long (Ref Long)] Bool))
(register safe-sub (λ [Long Long (Ref Long)] Bool))
(register safe-mul (λ [Long Long (Ref Long)] Bool))
)

6
core/prelude.h
View File

@ -47,6 +47,9 @@ int Int__PLUS_(int x, int y) { return x + y; }
int Int__MINUS_(int x, int y) { return x - y; }
int Int__MUL_(int x, int y) { return x * y; }
int Int__DIV_(int x, int y) { return x / y; }
bool Int_safe_MINUS_add(int x, int y, int* res) { return __builtin_sadd_overflow(x, y, res); }
bool Int_safe_MINUS_sub(int x, int y, int* res) { return __builtin_ssub_overflow(x, y, res); }
bool Int_safe_MINUS_mul(int x, int y, int* res) { return __builtin_smul_overflow(x, y, res); }
bool Int__EQ_(int x, int y) { return x == y; }
bool Int__DIV__EQ_(int x, int y) { return x != y; }
bool Int__LT_(int x, int y) { return x < y; }
@ -59,6 +62,9 @@ long Long__PLUS_(long x, long y) { return x + y; }
long Long__MINUS_(long x, long y) { return x - y; }
long Long__MUL_(long x, long y) { return x * y; }
long Long__DIV_(long x, long y) { return x / y; }
bool Long_safe_MINUS_add(long x, long y, long* res) { return __builtin_saddl_overflow(x, y, res); }
bool Long_safe_MINUS_sub(long x, long y, long* res) { return __builtin_ssubl_overflow(x, y, res); }
bool Long_safe_MINUS_mul(long x, long y, long* res) { return __builtin_smull_overflow(x, y, res); }
bool Long__EQ_(long x, long y) { return x == y; }
bool Long__LT_(long x, long y) { return x < y; }
bool Long__GT_(long x, long y) { return x > y; }

133
test/safe_artihmetic.carp Normal file
View File

@ -0,0 +1,133 @@
(use Bool)
(use Int)
(use Long)
(use Test)
(def i 1)
(def l 1l)
(defn return-res-int [f a b]
(let [c 0
_ false]
(do
(set! &_ (f a b &c))
c)))
(defn return-res-long [f a b]
(let [c 0l
_ false]
(do
(set! &_ (f a b &c))
c)))
(defn main []
(with-test test
(assert-equal test
false
(safe-add 1 2 &i)
"safe-add is false without overflow"
=
str)
(assert-equal test
3
(return-res-int safe-add 1 2)
"safe-add really adds"
=
str)
(assert-equal test
true
(safe-add 1000000000 2000000000 &i)
"safe-add is true with overflow"
=
str)
(assert-equal test
false
(safe-sub 1 2 &i)
"safe-sub is false without overflow"
=
str)
(assert-equal test
-1
(return-res-int safe-sub 1 2)
"safe-sub really subs"
=
str)
(assert-equal test
true
(safe-sub -1000000000 2000000000 &i)
"safe-sub is true with overflow"
=
str)
(assert-equal test
false
(safe-mul 1 2 &i)
"safe-mul is false without overflow"
=
str)
(assert-equal test
4
(return-res-int safe-mul 2 2)
"safe-mul really muls"
=
str)
(assert-equal test
true
(safe-mul 1000000000 2000000000 &i)
"safe-mul is true with overflow"
=
str)
(assert-equal test
false
(safe-add 1l 2l &l)
"safe-add is false without overflow"
=
str)
(assert-equal test
3l
(return-res-long safe-add 1l 2l)
"safe-add really adds"
=
str)
(assert-equal test
true
(safe-add 9000000000000000000l 2000000000000000000l &l)
"safe-add is true with overflow"
=
str)
(assert-equal test
false
(safe-sub 1l 2l &l)
"safe-sub is false without overflow"
=
str)
(assert-equal test
-1l
(return-res-long safe-sub 1l 2l)
"safe-sub really subs"
=
str)
(assert-equal test
true
(safe-sub 9000000000000000000l -2000000000000000000l &l)
"safe-sub is true with overflow"
=
str)
(assert-equal test
false
(safe-mul 1l 2l &l)
"safe-mul is false without overflow"
=
str)
(assert-equal test
4l
(return-res-long safe-mul 2l 2l)
"safe-mul really muls"
=
str)
(assert-equal test
true
(safe-mul 9000000000000000000l 2000000000000000000l &l)
"safe-mul is true with overflow"
=
str)
(print-test-results test)))