floorbody: Init implementation [skip ci]

OculusMode · Aug 12, 2021 · 2f8e219 · 2f8e219
1 parent 63aa009
commit 2f8e219
Showing 1 changed file with 41 additions and 1 deletion.
diff --git a/src/lfortran/semantics/ast_body_visitor.cpp b/src/lfortran/semantics/ast_body_visitor.cpp
@@ -35,10 +35,10 @@ class BodyVisitor : public AST::BaseVisitor<BodyVisitor> {
         {"minval", "lfortran_intrinsic_array"},
         {"maxval", "lfortran_intrinsic_array"},
         {"real", "lfortran_intrinsic_array"},
+        {"floor", "lfortran_intrinsic_array"},
         {"sum", "lfortran_intrinsic_array"},
         {"abs", "lfortran_intrinsic_math2"},
         {"sqrt", "lfortran_intrinsic_math2"},
-        {"real", "lfortran_intrinsic_array"},
         {"tiny", "lfortran_intrinsic_array"}
 };
 
@@ -1481,6 +1481,46 @@ class BodyVisitor : public AST::BaseVisitor<BodyVisitor> {
                                 throw SemanticError("real must have only one argument", x.base.base.loc);
                             }
                         }
+                        else if (var_name=="floor") {
+                            // TODO: Implement optional kind; J3/18-007r1 --> FLOOR(A, [KIND])
+                            if (args.n==1) {
+                            ASR::expr_t* func_expr = args[0];
+                            ASR::ttype_t* func_type = LFortran::ASRUtils::expr_type(func_expr);
+                            int func_kind = ASRUtils::extract_kind_from_ttype_t(func_type);
+                            int64_t ival {0};
+                            if (LFortran::ASR::is_a<LFortran::ASR::Real_t>(*func_type)) {
+                                if (func_kind == 4){
+                                    float rv = ASR::down_cast<ASR::ConstantReal_t>(
+                                        LFortran::ASRUtils::expr_value(func_expr))->m_r;
+                                    if (rv<0) {
+                                        // negative number
+                                        // floor -> integer(|x|+1)
+                                        ival = static_cast<int64_t>(rv-1);
+                                    } else {
+                                        // positive, floor -> integer(x)
+                                        ival = static_cast<int64_t>(rv);
+                                    }
+                                    value = ASR::down_cast<ASR::expr_t>(ASR::make_ConstantInteger_t(al, x.base.base.loc, ival,func_type));
+                                } else {
+                                    double rv = ASR::down_cast<ASR::ConstantReal_t>(LFortran::ASRUtils::expr_value(func_expr))->m_r;
+                                    int64_t ival = static_cast<int64_t>(rv);
+                                    if (rv<0) {
+                                        // negative number
+                                        // floor -> integer(x+1)
+                                        ival = static_cast<int64_t>(rv+1);
+                                    } else {
+                                        // positive, floor -> integer(x)
+                                        ival = static_cast<int64_t>(rv);
+                                    }
+                                    value = ASR::down_cast<ASR::expr_t>(ASR::make_ConstantInteger_t(al, x.base.base.loc, ival,func_type));
+                                }
+                            } else {
+                                throw SemanticError("floor must have one real argument", x.base.base.loc);
+                            }
+                            } else {
+                                throw SemanticError("floor with optional kind not yet implemented;\n will only work with one real argument", x.base.base.loc);
+                            }
+                        }
                         else if (func_name == "kind") {
                             if (args.n == 1) {
                                 int64_t kind_val {4};