add sin and tan intrinsic fns

src/core.f90

@@ -219,7 +219,9 @@ subroutine declare_intrinsic_fns(fns)
 		sum_f32_fn, sum_i64_fn, parse_f32_fn, min_f32_fn, max_f32_fn, &
 		char_fn, sum_f64_fn, parse_f64_fn, min_f64_fn, max_f64_fn, exp_f64_fn, &
 		exp_f32_arr_fn, exp_f64_arr_fn, &
-		cos_f32_fn, cos_f64_fn, cos_f32_arr_fn, cos_f64_arr_fn
+		cos_f32_fn, cos_f64_fn, cos_f32_arr_fn, cos_f64_arr_fn, &
+		sin_f32_fn, sin_f64_fn, sin_f32_arr_fn, sin_f64_arr_fn, &
+		tan_f32_fn, tan_f64_fn, tan_f32_arr_fn, tan_f64_arr_fn
 
 	! Increment index for each fn and then set num_fns
 	id_index = 0
@@ -339,6 +341,116 @@ subroutine declare_intrinsic_fns(fns)
 
 	!********
 
+	sin_f32_fn%type%type = f32_type
+	allocate(sin_f32_fn%params(1))
+	allocate(sin_f32_fn%param_names%v(1))
+	sin_f32_fn%params(1)%type = f32_type
+	sin_f32_fn%param_names%v(1)%s = "x"
+
+	! Insert the fn into the dict. These are global intrinsic fns, so there's no
+	! need to check iostat
+
+	call fns%insert("0sin_f32", sin_f32_fn, id_index)
+
+	!********
+
+	sin_f64_fn%type%type = f64_type
+	allocate(sin_f64_fn%params(1))
+	allocate(sin_f64_fn%param_names%v(1))
+	sin_f64_fn%params(1)%type = f64_type
+	sin_f64_fn%param_names%v(1)%s = "x"
+
+	call fns%insert("0sin_f64", sin_f64_fn, id_index)
+
+	!********
+
+	sin_f32_arr_fn%type%type = array_type
+	allocate(sin_f32_arr_fn%type%array)
+	sin_f32_arr_fn%type%array%type = f32_type
+	sin_f32_arr_fn%type%array%rank = -1
+
+	allocate(sin_f32_arr_fn%params(1))
+	allocate(sin_f32_arr_fn%param_names%v(1))
+
+	sin_f32_arr_fn%params(1)%type = any_type
+
+	sin_f32_arr_fn%param_names%v(1)%s = "x"
+
+	call fns%insert("0sin_f32_arr", sin_f32_arr_fn, id_index)
+
+	!********
+
+	sin_f64_arr_fn%type%type = array_type
+	allocate(sin_f64_arr_fn%type%array)
+	sin_f64_arr_fn%type%array%type = f64_type
+	sin_f64_arr_fn%type%array%rank = -1
+
+	allocate(sin_f64_arr_fn%params(1))
+	allocate(sin_f64_arr_fn%param_names%v(1))
+
+	sin_f64_arr_fn%params(1)%type = any_type
+
+	sin_f64_arr_fn%param_names%v(1)%s = "x"
+
+	call fns%insert("0sin_f64_arr", sin_f64_arr_fn, id_index)
+
+	!********
+
+	tan_f32_fn%type%type = f32_type
+	allocate(tan_f32_fn%params(1))
+	allocate(tan_f32_fn%param_names%v(1))
+	tan_f32_fn%params(1)%type = f32_type
+	tan_f32_fn%param_names%v(1)%s = "x"
+
+	! Insert the fn into the dict. These are global intrinsic fns, so there's no
+	! need to check iostat
+
+	call fns%insert("0tan_f32", tan_f32_fn, id_index)
+
+	!********
+
+	tan_f64_fn%type%type = f64_type
+	allocate(tan_f64_fn%params(1))
+	allocate(tan_f64_fn%param_names%v(1))
+	tan_f64_fn%params(1)%type = f64_type
+	tan_f64_fn%param_names%v(1)%s = "x"
+
+	call fns%insert("0tan_f64", tan_f64_fn, id_index)
+
+	!********
+
+	tan_f32_arr_fn%type%type = array_type
+	allocate(tan_f32_arr_fn%type%array)
+	tan_f32_arr_fn%type%array%type = f32_type
+	tan_f32_arr_fn%type%array%rank = -1
+
+	allocate(tan_f32_arr_fn%params(1))
+	allocate(tan_f32_arr_fn%param_names%v(1))
+
+	tan_f32_arr_fn%params(1)%type = any_type
+
+	tan_f32_arr_fn%param_names%v(1)%s = "x"
+
+	call fns%insert("0tan_f32_arr", tan_f32_arr_fn, id_index)
+
+	!********
+
+	tan_f64_arr_fn%type%type = array_type
+	allocate(tan_f64_arr_fn%type%array)
+	tan_f64_arr_fn%type%array%type = f64_type
+	tan_f64_arr_fn%type%array%rank = -1
+
+	allocate(tan_f64_arr_fn%params(1))
+	allocate(tan_f64_arr_fn%param_names%v(1))
+
+	tan_f64_arr_fn%params(1)%type = any_type
+
+	tan_f64_arr_fn%param_names%v(1)%s = "x"
+
+	call fns%insert("0tan_f64_arr", tan_f64_arr_fn, id_index)
+
+	!********
+
 	! We could make max() and min() work with just 1 argument too.  I'm not sure
 	! why you would want to be able to take the max of 1 number, but it seems
 	! like an arbitrary limitation.  Anyway we follow the Fortran convention
@@ -870,6 +982,8 @@ subroutine declare_intrinsic_fns(fns)
 		[ &
 			exp_f32_fn    , exp_f64_fn    , exp_f32_arr_fn, exp_f64_arr_fn, &
 			cos_f32_fn    , cos_f64_fn    , cos_f32_arr_fn, cos_f64_arr_fn, &
+			sin_f32_fn    , sin_f64_fn    , sin_f32_arr_fn, sin_f64_arr_fn, &
+			tan_f32_fn    , tan_f64_fn    , tan_f32_arr_fn, tan_f64_arr_fn, &
 			min_i32_fn    , &
 			min_i64_fn    , &
 			min_f32_fn    , &

src/eval.f90

@@ -789,6 +789,60 @@ recursive subroutine eval_fn_call(node, state, res)
 		res%array%f64 = cos(arg1%array%f64)
 		state%returned = .true.
 
+	!********
+	case ("0sin_f32")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%sca%f32 = sin(arg1%sca%f32)
+		state%returned = .true.
+
+	case ("0sin_f64")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%sca%f64 = sin(arg1%sca%f64)
+		state%returned = .true.
+
+	case ("0sin_f32_arr")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%array = mold(arg1%array, f32_type)
+		res%array%f32 = sin(arg1%array%f32)
+		state%returned = .true.
+
+	case ("0sin_f64_arr")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%array = mold(arg1%array, f64_type)
+		res%array%f64 = sin(arg1%array%f64)
+		state%returned = .true.
+
+	!********
+	case ("0tan_f32")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%sca%f32 = tan(arg1%sca%f32)
+		state%returned = .true.
+
+	case ("0tan_f64")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%sca%f64 = tan(arg1%sca%f64)
+		state%returned = .true.
+
+	case ("0tan_f32_arr")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%array = mold(arg1%array, f32_type)
+		res%array%f32 = tan(arg1%array%f32)
+		state%returned = .true.
+
+	case ("0tan_f64_arr")
+
+		call syntax_eval(node%args(1), state, arg1)
+		res%array = mold(arg1%array, f64_type)
+		res%array%f64 = tan(arg1%array%f64)
+		state%returned = .true.
+
 	!********
 	case ("0min_i32")
 

src/parse_fn.f90

@@ -99,6 +99,72 @@ recursive subroutine resolve_overload(args, fn_call, has_rank)
 			fn_call%identifier%text = "0cos_f64"
 		end select
 
+	case ("sin")
+
+		type_ = f64_type
+		if (args%len_ >= 1) type_ = args%v(1)%val%type
+
+		select case (type_)
+		case (array_type)
+
+			arr_type = args%v(1)%val%array%type
+			!print *, "type = ", kind_name(arr_type)
+
+			select case (arr_type)
+			case (f32_type)
+				fn_call%identifier%text = "0sin_f32_arr"
+			case (f64_type)
+				fn_call%identifier%text = "0sin_f64_arr"
+			case default
+				! Fall-back on scalar to throw a parser error later
+				fn_call%identifier%text = "0sin_f64"
+			end select
+
+			if (args%len_ >= 1) then
+				has_rank = .true.
+				allocate(fn_call%val%array)
+				fn_call%val%array%rank = args%v(1)%val%array%rank
+			end if
+
+		case (f32_type)
+			fn_call%identifier%text = "0sin_f32"
+		case default
+			fn_call%identifier%text = "0sin_f64"
+		end select
+
+	case ("tan")
+
+		type_ = f64_type
+		if (args%len_ >= 1) type_ = args%v(1)%val%type
+
+		select case (type_)
+		case (array_type)
+
+			arr_type = args%v(1)%val%array%type
+			!print *, "type = ", kind_name(arr_type)
+
+			select case (arr_type)
+			case (f32_type)
+				fn_call%identifier%text = "0tan_f32_arr"
+			case (f64_type)
+				fn_call%identifier%text = "0tan_f64_arr"
+			case default
+				! Fall-back on scalar to throw a parser error later
+				fn_call%identifier%text = "0tan_f64"
+			end select
+
+			if (args%len_ >= 1) then
+				has_rank = .true.
+				allocate(fn_call%val%array)
+				fn_call%val%array%rank = args%v(1)%val%array%rank
+			end if
+
+		case (f32_type)
+			fn_call%identifier%text = "0tan_f32"
+		case default
+			fn_call%identifier%text = "0tan_f64"
+		end select
+
 	case ("min")
 
 		type_ = i32_type

src/tests/test.f90

@@ -650,6 +650,26 @@ subroutine unit_test_intr_fns(npass, nfail)
 			abs(eval_f64('sum(cos([0.0, 1.0]));') - sum(cos([0.d0, 1.0d0])))  < tol,  &
 			abs(eval_f64('sum(cos([0.5, 1.0]));') - sum(cos([0.5d0, 1.0d0]))) < tol,  &
 			abs(eval_f64('sum(cos([2.0, 1.0]));') - sum(cos([2.d0, 1.0d0])))  < tol,  &
+			abs(eval_f32('sin(0.0f);') - sin(0.0)) < tol,  &
+			abs(eval_f32('sin(1.0f);') - sin(1.0)) < tol,  &
+			abs(eval_f64('sin(0.0);') - sin(0.d0)) < tol,  &
+			abs(eval_f64('sin(1.0);') - sin(1.0d0)) < tol,  &
+			abs(eval_f32('sum(sin([0.0f, 1.0f]));') - sum(sin([0.0, 1.0])))   < ftol,  &
+			abs(eval_f32('sum(sin([0.5f, 1.0f]));') - sum(sin([0.5, 1.0])))   < ftol,  &
+			abs(eval_f32('sum(sin([2.0f, 1.0f]));') - sum(sin([2.0, 1.0])))   < ftol,  &
+			abs(eval_f64('sum(sin([0.0, 1.0]));') - sum(sin([0.d0, 1.0d0])))  < tol,  &
+			abs(eval_f64('sum(sin([0.5, 1.0]));') - sum(sin([0.5d0, 1.0d0]))) < tol,  &
+			abs(eval_f64('sum(sin([2.0, 1.0]));') - sum(sin([2.d0, 1.0d0])))  < tol,  &
+			abs(eval_f32('tan(0.0f);') - tan(0.0)) < tol,  &
+			abs(eval_f32('tan(1.0f);') - tan(1.0)) < tol,  &
+			abs(eval_f64('tan(0.0);') - tan(0.d0)) < tol,  &
+			abs(eval_f64('tan(1.0);') - tan(1.0d0)) < tol,  &
+			abs(eval_f32('sum(tan([0.0f, 1.0f]));') - sum(tan([0.0, 1.0])))   < ftol,  &
+			abs(eval_f32('sum(tan([0.5f, 1.0f]));') - sum(tan([0.5, 1.0])))   < ftol,  &
+			abs(eval_f32('sum(tan([2.0f, 1.0f]));') - sum(tan([2.0, 1.0])))   < ftol,  &
+			abs(eval_f64('sum(tan([0.0, 1.0]));') - sum(tan([0.d0, 1.0d0])))  < tol,  &
+			abs(eval_f64('sum(tan([0.5, 1.0]));') - sum(tan([0.5d0, 1.0d0]))) < tol,  &
+			abs(eval_f64('sum(tan([2.0, 1.0]));') - sum(tan([2.d0, 1.0d0])))  < tol,  &
 			eval_i32('min(3, 2);')  == 2,  &
 			eval_i32('min(2, 2);')  == 2,  &
 			eval_i32('min(2, 3, 4);')  == 2,  &