@@ -1358,6 +1358,14 @@ namespace FlipSign {
1358
1358
x.base .base .loc , diagnostics);
1359
1359
}
1360
1360
1361
+ static ASR::expr_t *eval_FlipSign (Allocator &al, const Location &loc,
1362
+ ASR::ttype_t * t1, Vec<ASR::expr_t *> &args) {
1363
+ int a = ASR::down_cast<ASR::IntegerConstant_t>(args[0 ])->m_n ;
1364
+ double b = ASR::down_cast<ASR::RealConstant_t>(args[1 ])->m_r ;
1365
+ if (a % 2 == 1 ) b = -b;
1366
+ return make_ConstantWithType (make_RealConstant_t, b, t1, loc);
1367
+ }
1368
+
1361
1369
static inline ASR::asr_t * create_FlipSign (Allocator& al, const Location& loc,
1362
1370
Vec<ASR::expr_t *>& args,
1363
1371
const std::function<void (const std::string &, const Location &)> err) {
@@ -1371,6 +1379,12 @@ namespace FlipSign {
1371
1379
args[0 ]->base .loc );
1372
1380
}
1373
1381
ASR::expr_t *m_value = nullptr ;
1382
+ if (all_args_evaluated (args)) {
1383
+ Vec<ASR::expr_t *> arg_values; arg_values.reserve (al, 2 );
1384
+ arg_values.push_back (al, expr_value (args[0 ]));
1385
+ arg_values.push_back (al, expr_value (args[1 ]));
1386
+ m_value = eval_FlipSign (al, loc, expr_type (args[1 ]), arg_values);
1387
+ }
1374
1388
return ASR::make_IntrinsicScalarFunction_t (al, loc,
1375
1389
static_cast <int64_t >(IntrinsicScalarFunctions::FlipSign),
1376
1390
args.p , args.n , 0 , ASRUtils::expr_type (args[1 ]), m_value);
@@ -1383,9 +1397,20 @@ namespace FlipSign {
1383
1397
fill_func_arg (" signal" , arg_types[0 ]);
1384
1398
fill_func_arg (" variable" , arg_types[1 ]);
1385
1399
auto result = declare (fn_name, return_type, ReturnVar);
1400
+ /*
1401
+ real(real32) function flipsigni32r32(signal, variable)
1402
+ integer(int32), intent(in) :: signal
1403
+ real(real32), intent(out) :: variable
1404
+ integer(int32) :: q
1405
+ q = signal/2
1406
+ flipsigni32r32 = variable
1407
+ if (signal - 2*q == 1 ) flipsigni32r32 = -variable
1408
+ end subroutine
1409
+ */
1410
+
1386
1411
ASR::expr_t *two = i (2 , arg_types[0 ]);
1387
1412
ASR::expr_t *q = iDiv (args[0 ], two);
1388
- ASR::expr_t *cond = iMul (args[0 ], iMul (two, q));
1413
+ ASR::expr_t *cond = iSub (args[0 ], iMul (two, q));
1389
1414
body.push_back (al, b.If (iEq (cond, i (1 , arg_types[0 ])), {
1390
1415
b.Assignment (result, f32_neg (args[1 ], arg_types[1 ]))
1391
1416
}, {
0 commit comments