mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-12 04:58:18 +03:00
added stuff for doubles
This commit is contained in:
parent
4c58b42c7e
commit
960847893e
@ -89,6 +89,7 @@
|
||||
(:ref r) (type-build-internal r star)
|
||||
(:Array a) (str "Array" (if star "*" "")) ;; TODO: case not needed
|
||||
:float "float"
|
||||
:double "double"
|
||||
:int "int"
|
||||
:char "char"
|
||||
:bool "bool"
|
||||
|
@ -1,28 +1,49 @@
|
||||
;; Int math
|
||||
(register-builtin "srand" '(:int) :void)
|
||||
(register-builtin "rand" '() :int)
|
||||
(register-builtin "max" '(:int :int) :int)
|
||||
(register-builtin "inc" '(:int) :int)
|
||||
(register-builtin "dec" '(:int) :int)
|
||||
(register-builtin "mod" '(:int :int) :int)
|
||||
|
||||
;; Double math
|
||||
(register-builtin "sin" '(:double) :double)
|
||||
(register-builtin "cos" '(:double) :double)
|
||||
(register-builtin "sqrt" '(:double) :double)
|
||||
|
||||
;; Float math
|
||||
(register-builtin "sinf" '(:float) :float)
|
||||
(register-builtin "cosf" '(:float) :float)
|
||||
(register-builtin "sqrtf" '(:float) :float)
|
||||
|
||||
;; Conversions
|
||||
(register-builtin "itof" '(:int) :float)
|
||||
(register-builtin "itos" '(:int) :string)
|
||||
(register-builtin "panic" '((:ref :string)) :void)
|
||||
(register-builtin "printf" '((:ref :string)) :void)
|
||||
(register-builtin "print" '((:ref :string)) :void)
|
||||
(register-builtin "println" '((:ref :string)) :void)
|
||||
(register-builtin "sleep" '(:int) :void)
|
||||
(register-builtin "nullQMARK" '(:any) :bool)
|
||||
(register-builtin "not" '(:bool) :bool)
|
||||
|
||||
;; Strings
|
||||
(register-builtin "strlen" '((:ref :string)) :int)
|
||||
(register-builtin "string_append" '((:ref :string) (:ref :string)) :string)
|
||||
(register-builtin "file_existsQMARK" '((:ref :string)) :bool)
|
||||
(register-builtin "eat_string" '(:string) :void)
|
||||
(register-builtin "string_copy" '((:ref :string)) :string)
|
||||
(register-builtin "async" '((:fn () :void)) :void)
|
||||
(register-builtin "last_index_of" '(:string :char) :int)
|
||||
(register-builtin "substring" '(:string :int) :string)
|
||||
(register-builtin "file_path_component" '(:string) :string)
|
||||
|
||||
;; IO
|
||||
(register-builtin "printf" '((:ref :string)) :void)
|
||||
(register-builtin "print" '((:ref :string)) :void)
|
||||
(register-builtin "println" '((:ref :string)) :void)
|
||||
(register-builtin "get_input" '() :string)
|
||||
(register-builtin "mod" '(:int :int) :int)
|
||||
|
||||
;; Files
|
||||
(register-builtin "file_existsQMARK" '((:ref :string)) :bool)
|
||||
|
||||
;; System
|
||||
(register-builtin "panic" '((:ref :string)) :void)
|
||||
(register-builtin "sleep" '(:int) :void)
|
||||
(register-builtin "async" '((:fn () :void)) :void)
|
||||
|
||||
;;Misc
|
||||
(register-builtin "nullQMARK" '(:any) :bool)
|
||||
(register-builtin "not" '(:bool) :bool)
|
||||
|
||||
|
@ -62,6 +62,9 @@
|
||||
;; (defmacro quasiquote (form)
|
||||
;; (list 'quote (map replace-dequotes form)))
|
||||
|
||||
(defmacro assert (x)
|
||||
(list 'assert-eq true x))
|
||||
|
||||
(defn assert-approx-eq (target x)
|
||||
(do
|
||||
(assert-eq true (< x (+ target 0.1)))
|
||||
|
@ -1,4 +1,9 @@
|
||||
|
||||
(defn test-doubles []
|
||||
(let [x 3.0d
|
||||
y 5.0d]
|
||||
(assert (< 14.0d (* x y) 16.0d))))
|
||||
|
||||
(defn test-bind-to-function-in-let []
|
||||
(do (defn misbind []
|
||||
(let [(fn [] nil) 123]
|
||||
@ -400,6 +405,7 @@
|
||||
(test-match-array)
|
||||
(test-template)
|
||||
(test-bind-to-function-in-let)
|
||||
(test-doubles)
|
||||
))
|
||||
|
||||
(run-core-tests)
|
||||
|
@ -229,7 +229,7 @@
|
||||
x (error (str "Invalid type for call to 'map-copy': " x)))
|
||||
|
||||
"str" (do
|
||||
;;(println (str "Calling str for signature: " signature))
|
||||
(println (str "Calling str for signature: " signature))
|
||||
(match signature
|
||||
|
||||
(:fn ((:ref (:Array t))) :string) (instantiate-str-for-array c-func-name t)
|
||||
@ -254,6 +254,14 @@
|
||||
"}")]
|
||||
{:proto proto :c c :deps ()})
|
||||
|
||||
(:fn (:double) :string) (let [proto (str "API string " c-func-name "(double x)")
|
||||
c (str proto " { "
|
||||
" char output[50];"
|
||||
" snprintf(output, 50, \"%f\", x);"
|
||||
" return strdup(output);"
|
||||
"}")]
|
||||
{:proto proto :c c :deps ()})
|
||||
|
||||
(:fn ((:ref :string)) :string) (instantiate-str-for-string c-func-name)
|
||||
|
||||
(:fn ((:ref maybe-struct-type)) :string) (instantiate-str-for-struct c-func-name maybe-struct-type)
|
||||
|
18
src/eval.c
18
src/eval.c
@ -320,6 +320,10 @@ void call_lambda_from_ffi(ffi_cif *cif, void *ret, void* args[], LambdaAndItsTyp
|
||||
float *x = args[i];
|
||||
obj_args[i] = obj_new_float(*x);
|
||||
}
|
||||
else if(cif->arg_types[i] == &ffi_type_double) {
|
||||
double *x = args[i];
|
||||
obj_args[i] = obj_new_double(*x);
|
||||
}
|
||||
else if(cif->arg_types[i] == &ffi_type_schar) {
|
||||
char *x = args[i];
|
||||
obj_args[i] = obj_new_char(*x);
|
||||
@ -378,6 +382,11 @@ void call_lambda_from_ffi(ffi_cif *cif, void *ret, void* args[], LambdaAndItsTyp
|
||||
float *x = ret;
|
||||
*x = result->f32;
|
||||
}
|
||||
else if(obj_eq(lambda_return_type, type_double)) {
|
||||
assert_or_set_error(result->tag == 'W', "Invalid type of return value ", result);
|
||||
double *x = ret;
|
||||
*x = result->f64;
|
||||
}
|
||||
else if(obj_eq(lambda_return_type, type_string)) {
|
||||
assert_or_set_error(result->tag == 'S', "Invalid type of return value ", result);
|
||||
char **s = ret;
|
||||
@ -475,6 +484,10 @@ void apply(Obj *function, Obj **args, int arg_count) {
|
||||
assert_or_free_values_and_set_error(args[i]->tag == 'V', "Invalid (expected float) type of arg: ", args[i]);
|
||||
values[i] = &args[i]->f32;
|
||||
}
|
||||
else if(obj_eq(type_obj, type_double)) {
|
||||
assert_or_free_values_and_set_error(args[i]->tag == 'W', "Invalid (expected double) type of arg: ", args[i]);
|
||||
values[i] = &args[i]->f64;
|
||||
}
|
||||
else if(obj_eq(type_obj, type_string)) {
|
||||
assert_or_free_values_and_set_error(args[i]->tag == 'S', "Invalid (expected string) type of arg: ", args[i]);
|
||||
//args[i]->s = strdup(args[i]->s); // OBS! Duplicating string here. TODO: Think about if this is the correct thing to do!
|
||||
@ -606,6 +619,11 @@ void apply(Obj *function, Obj **args, int arg_count) {
|
||||
ffi_call(function->cif, function->funptr, &result, values);
|
||||
obj_result = obj_new_float(result);
|
||||
}
|
||||
else if(obj_eq(return_type, type_double)) {
|
||||
double result;
|
||||
ffi_call(function->cif, function->funptr, &result, values);
|
||||
obj_result = obj_new_double(result);
|
||||
}
|
||||
else if(obj_eq(return_type, type_void)) {
|
||||
//printf("Returning void.\n");
|
||||
ffi_sarg result;
|
||||
|
@ -218,6 +218,9 @@ Obj *obj_copy(Obj *o) {
|
||||
else if(o->tag == 'V') {
|
||||
return obj_new_float(o->f32);
|
||||
}
|
||||
else if(o->tag == 'W') {
|
||||
return obj_new_float(o->f64);
|
||||
}
|
||||
else if(o->tag == 'S') {
|
||||
return obj_new_string(strdup(o->s));
|
||||
}
|
||||
|
@ -168,6 +168,7 @@ Obj *type_symbol;
|
||||
Obj *type_macro;
|
||||
Obj *type_void;
|
||||
Obj *type_float;
|
||||
Obj *type_double;
|
||||
Obj *type_ptr;
|
||||
Obj *type_ref;
|
||||
Obj *type_char;
|
||||
|
@ -96,6 +96,17 @@ Obj *p_add(Obj** args, int arg_count) {
|
||||
}
|
||||
return obj_new_float(sum);
|
||||
}
|
||||
else if(args[0]->tag == 'W') {
|
||||
double sum = 0;
|
||||
for(int i = 0; i < arg_count; i++) {
|
||||
if(args[i]->tag != 'W') {
|
||||
eval_error = obj_new_string("Args to add must be doubles.\n");
|
||||
return nil;
|
||||
}
|
||||
sum += args[i]->f64;
|
||||
}
|
||||
return obj_new_double(sum);
|
||||
}
|
||||
else {
|
||||
eval_error = obj_new_string("Can't add non-numbers together.");
|
||||
return nil;
|
||||
@ -121,6 +132,16 @@ Obj *p_sub(Obj** args, int arg_count) {
|
||||
}
|
||||
return obj_new_float(sum);
|
||||
}
|
||||
else if(args[0]->tag == 'W') {
|
||||
if(arg_count == 1) {
|
||||
return obj_new_int((int)-args[0]->f64);
|
||||
}
|
||||
double sum = args[0]->f64;
|
||||
for(int i = 1; i < arg_count; i++) {
|
||||
sum -= args[i]->f64;
|
||||
}
|
||||
return obj_new_double(sum);
|
||||
}
|
||||
else {
|
||||
eval_error = obj_new_string("Can't subtract non-numbers.");
|
||||
return nil;
|
||||
@ -146,6 +167,13 @@ Obj *p_mul(Obj** args, int arg_count) {
|
||||
}
|
||||
return obj_new_float(prod);
|
||||
}
|
||||
else if(args[0]->tag == 'W') {
|
||||
double prod = args[0]->f64;
|
||||
for(int i = 1; i < arg_count; i++) {
|
||||
prod *= args[i]->f64;
|
||||
}
|
||||
return obj_new_double(prod);
|
||||
}
|
||||
else {
|
||||
eval_error = obj_new_string("Can't multiply non-numbers.");
|
||||
return nil;
|
||||
@ -171,6 +199,13 @@ Obj *p_div(Obj** args, int arg_count) {
|
||||
}
|
||||
return obj_new_float(prod);
|
||||
}
|
||||
else if(args[0]->tag == 'W') {
|
||||
double prod = args[0]->f64;
|
||||
for(int i = 1; i < arg_count; i++) {
|
||||
prod /= args[i]->f64;
|
||||
}
|
||||
return obj_new_double(prod);
|
||||
}
|
||||
else {
|
||||
eval_error = obj_new_string("Can't divide non-numbers.");
|
||||
return nil;
|
||||
@ -757,6 +792,9 @@ Obj *p_map(Obj** args, int arg_count) {
|
||||
else if(obj_eq(inner_type, type_float)) {
|
||||
arg[0] = obj_new_float(((float*)(a->data))[i]);
|
||||
}
|
||||
else if(obj_eq(inner_type, type_double)) {
|
||||
arg[0] = obj_new_double(((float*)(a->data))[i]);
|
||||
}
|
||||
else if(obj_eq(inner_type, type_int)) {
|
||||
arg[0] = obj_new_int(((int*)(a->data))[i]);
|
||||
}
|
||||
@ -1031,6 +1069,9 @@ Obj *p_type(Obj** args, int arg_count) {
|
||||
else if(args[0]->tag == 'V') {
|
||||
return type_float;
|
||||
}
|
||||
else if(args[0]->tag == 'W') {
|
||||
return type_double;
|
||||
}
|
||||
else if(args[0]->tag == 'C') {
|
||||
return type_list;
|
||||
}
|
||||
@ -1079,6 +1120,7 @@ Obj *p_lt(Obj** args, int arg_count) {
|
||||
if(args[0]->tag == 'I') {
|
||||
int smallest = args[0]->i;
|
||||
for(int i = 1; i < arg_count; i++) {
|
||||
assert_or_set_error_return_nil(args[i]->tag == 'I', "< for ints called with non-int: ", args[0]);
|
||||
if(smallest >= args[i]->i) { return lisp_false; }
|
||||
smallest = args[i]->i;
|
||||
}
|
||||
@ -1087,11 +1129,21 @@ Obj *p_lt(Obj** args, int arg_count) {
|
||||
else if(args[0]->tag == 'V') {
|
||||
float smallest = args[0]->f32;
|
||||
for(int i = 1; i < arg_count; i++) {
|
||||
assert_or_set_error_return_nil(args[i]->tag == 'V', "< for floats called with non-float: ", args[0]);
|
||||
if(smallest >= args[i]->f32) { return lisp_false; }
|
||||
smallest = args[i]->f32;
|
||||
}
|
||||
return lisp_true;
|
||||
}
|
||||
else if(args[0]->tag == 'W') {
|
||||
double smallest = args[0]->f64;
|
||||
for(int i = 1; i < arg_count; i++) {
|
||||
assert_or_set_error_return_nil(args[i]->tag == 'W', "< for doubles called with non-double: ", args[0]);
|
||||
if(smallest >= args[i]->f64) { return lisp_false; }
|
||||
smallest = args[i]->f64;
|
||||
}
|
||||
return lisp_true;
|
||||
}
|
||||
else {
|
||||
eval_error = obj_new_string("Can't call < on non-numbers.");
|
||||
return lisp_false;
|
||||
@ -1287,6 +1339,9 @@ ffi_type *lisp_type_to_ffi_type(Obj *type_obj) {
|
||||
else if(obj_eq(type_obj, type_float)) {
|
||||
return &ffi_type_float;
|
||||
}
|
||||
else if(obj_eq(type_obj, type_double)) {
|
||||
return &ffi_type_double;
|
||||
}
|
||||
else if(obj_eq(type_obj, type_void)) {
|
||||
return &ffi_type_uint;
|
||||
}
|
||||
|
@ -114,6 +114,9 @@ void env_new_global() {
|
||||
|
||||
type_float = obj_new_keyword("float");
|
||||
define("type-float", type_float);
|
||||
|
||||
type_double = obj_new_keyword("double");
|
||||
define("type-double", type_double);
|
||||
|
||||
type_string = obj_new_keyword("string");
|
||||
define("type-string", type_string);
|
||||
|
Loading…
Reference in New Issue
Block a user