Skip to content
Snippets Groups Projects

Draft: Compile / Run Minidftatom

Open Rohit Goswami requested to merge HaoZeke/lfortran:minidftatom into master

An MR to implement the bare minimum functionality for minidftatom to compile / run.

Should be split later.

Merge request reports

Loading
Loading

Activity

Filter activity
  • Approvals
  • Assignees & reviewers
  • Comments (from bots)
  • Comments (from users)
  • Commits & branches
  • Edits
  • Labels
  • Lock status
  • Mentions
  • Merge request status
  • Tracking
  • added GSoC label

  • assigned to @HaoZeke

  • Rohit Goswami added 1 commit

    added 1 commit

    • 766b043d - ast_visitors: Restructure to reduce duplication

    Compare with previous version

  • Rohit Goswami added 2 commits

    added 2 commits

    • d26ab0bd - floor: Hacky implementation [runtime]
    • 0029729b - exp: Very rough approximation [runtime]

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    • 7785de73 - exp: Work tentatively [runtime]

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    • 7cc07ca3 - exp: x>floor(x), use [0,1] [runtime]

    Compare with previous version

  • Rohit Goswami added 3 commits

    added 3 commits

    • 3d4baa00 - exp: Clean and fix gfortran errors
    • 2d60bc76 - sign: Implement rough draft [runtime]
    • 177ea334 - ast: Recognize sign

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    • 537be782 - exp: Fixup to get reasonable values [runtime]

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    • e27abc35 - exp: Fixup to get reasonable values [runtime]

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    • 1c09a124 - exp: Fixup to get reasonable values [runtime]

    Compare with previous version

  • Awesome. Thanks for working on this.

  • Rohit Goswami added 4 commits

    added 4 commits

    Compare with previous version

  • Rohit Goswami added 1 commit

    added 1 commit

    Compare with previous version

  • Author Developer

    Working energies.f90 before log:

    (TranslationUnit (SymbolTable 1 {constants: (Module (SymbolTable 14 {dp: (ExternalSymbol 14 dp 4 dp types dp Public), pi: (Variable 14 pi Local (ConstantReal 3.141593 (Real 8 [])) (ConstantReal 3.141593 (Real 8 [])) Parameter (Real 8 []) Source Public Required)}) constants [types] .true.), energies: (Module (SymbolTable 2 {E_nl: (Function (SymbolTable 15 {E_nl: (Variable 15 E_nl ReturnVar () () Default (Real 8 []) Source Public Required), Z: (Variable 15 Z In () () Default (Integer 4 []) Source Private Required), abs: (ExternalSymbol 15 abs 35 abs lfortran_intrinsic_math2 abs Private), abs@isabs: (ExternalSymbol 15 abs@isabs 35 isabs lfortran_intrinsic_math2 isabs Private), beta: (Variable 15 beta Local () () Default (Real 8 []) Source Private Required), c: (Variable 15 c In () () Default (Real 8 []) Source Private Required), kappa: (Variable 15 kappa Local () () Default (Integer 4 []) Source Private Required), l: (Variable 15 l In () () Default (Integer 4 []) Source Private Required), n: (Variable 15 n In () () Default (Integer 4 []) Source Private Required), relat: (Variable 15 relat In () () Default (Integer 4 []) Source Private Required), sqrt: (ExternalSymbol 15 sqrt 35 sqrt lfortran_intrinsic_math2 sqrt Private), sqrt@dsqrt: (ExternalSymbol 15 sqrt@dsqrt 35 dsqrt lfortran_intrinsic_math2 dsqrt Private)}) E_nl [(Var 15 c) (Var 15 n) (Var 15 l) (Var 15 Z) (Var 15 relat)] [(If (UnaryOp Not (Compare (Var 15 l) GtE (ConstantInteger 0 (Integer 4 [])) (Logical 4 []) ()) (Logical 4 []) ()) [(ErrorStop (ConstantString "'l' must be positive or zero" (Character 8 [])))] []) (If (UnaryOp Not (Compare (Var 15 n) Gt (Var 15 l) (Logical 4 []) ()) (Logical 4 []) ()) [(ErrorStop (ConstantString "'n' must be greater than 'l'" (Character 8 [])))] []) (If (BoolOp (Compare (Var 15 l) Eq (ConstantInteger 0 (Integer 4 [])) (Logical 4 []) ()) And (Compare (Var 15 relat) Eq (ConstantInteger 3 (Integer 4 [])) (Logical 4 []) ()) (Logical 4 []) ()) [(ErrorStop (ConstantString "Spin must be up for l==0." (Character 8 [])))] []) (If (Compare (Var 15 relat) Eq (ConstantInteger 0 (Integer 4 [])) (Logical 4 []) ()) [(= (Var 15 E_nl) (BinOp (ImplicitCast (UnaryOp USub (BinOp (Var 15 Z) Pow (ConstantInteger 2 (Integer 4 [])) (Integer 4 []) ()) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) Div (BinOp (ConstantReal 2.000000 (Real 8 [])) Mul (ImplicitCast (BinOp (Var 15 n) Pow (ConstantInteger 2 (Integer 4 [])) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) (Real 8 []) ()) (Real 8 []) ()))] [(If (Compare (Var 15 relat) Eq (ConstantInteger 2 (Integer 4 [])) (Logical 4 []) ()) [(= (Var 15 kappa) (BinOp (UnaryOp USub (Var 15 l) (Integer 4 []) ()) Sub (ConstantInteger 1 (Integer 4 [])) (Integer 4 []) ()))] [(= (Var 15 kappa) (Var 15 l))]) (= (Var 15 beta) (FunctionCall 15 sqrt@dsqrt 15 sqrt [(BinOp (ImplicitCast (BinOp (Var 15 kappa) Pow (ConstantInteger 2 (Integer 4 [])) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) Sub (BinOp (BinOp (ImplicitCast (Var 15 Z) IntegerToReal (Real 8 []) ()) Div (Var 15 c) (Real 8 []) ()) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) ()) (Real 8 []) ())] [] (Real 8 []) () ())) (= (Var 15 E_nl) (BinOp (BinOp (BinOp (Var 15 c) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) ()) Div (FunctionCall 15 sqrt@dsqrt 15 sqrt [(BinOp (ImplicitCast (ConstantInteger 1 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 1.000000 (Real 8 []))) Add (BinOp (BinOp (BinOp (ImplicitCast (Var 15 Z) IntegerToReal (Real 8 []) ()) Div (Var 15 c) (Real 8 []) ()) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) ()) Div (BinOp (BinOp (ImplicitCast (BinOp (Var 15 n) Sub (FunctionCall 15 abs@isabs 15 abs [(Var 15 kappa)] [] (Integer 4 []) () ()) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) Add (Var 15 beta) (Real 8 []) ()) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) ()) (Real 8 []) ()) (Real 8 []) ())] [] (Real 8 []) () ()) (Real 8 []) ()) Sub (BinOp (Var 15 c) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) ()) (Real 8 []) ()))])] (Var 15 E_nl) Source Public Implementation), dp: (ExternalSymbol 2 dp 4 dp types dp Public), get_hydrogen_energies: (Function (SymbolTable 33 {E: (Variable 33 E ReturnVar () () Default (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 33 size () [(Var 33 no)] [] (Integer 4 []) () ()))]) Source Private Required), Z: (Variable 33 Z In () () Default (Integer 4 []) Source Private Required), i: (Variable 33 i Local () () Default (Integer 4 []) Source Private Required), no: (Variable 33 no In () () Default (Integer 4 [(() ())]) Source Private Required), size: (ExternalSymbol 33 size 18 size lfortran_intrinsic_array size Private)}) get_hydrogen_energies [(Var 33 Z) (Var 33 no)] [(DoLoop ((Var 33 i) (ConstantInteger 1 (Integer 4 [])) (FunctionCall 33 size () [(Var 33 no)] [] (Integer 4 []) () ()) ()) [(= (ArrayRef 33 E [(() (Var 33 i) ())] (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 33 size () [(Var 33 no)] [] (Integer 4 []) () ()))]) ()) (BinOp (BinOp (UnaryOp USub (ConstantReal 1.000000 (Real 8 [])) (Real 8 []) (ConstantReal -1.000000 (Real 8 []))) Mul (ImplicitCast (BinOp (Var 33 Z) Pow (ConstantInteger 2 (Integer 4 [])) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) (Real 8 []) ()) Div (ImplicitCast (BinOp (ConstantInteger 2 (Integer 4 [])) Mul (BinOp (ArrayRef 33 no [(() (Var 33 i) ())] (Integer 4 [(() ())]) ()) Pow (ConstantInteger 2 (Integer 4 [])) (Integer 4 [(() ())]) ()) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) (Real 8 []) ()))])] (Var 33 E) Source Public Implementation), pi: (ExternalSymbol 2 pi 14 pi constants pi Public), thomas_fermi_potential: (Function (SymbolTable 16 {R: (Variable 16 R In () () Default (Real 8 [(() ())]) Source Private Required), V: (Variable 16 V ReturnVar () () Default (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 16 size () [(Var 16 R)] [] (Integer 4 []) () ()))]) Source Private Required), Z: (Variable 16 Z In () () Default (Integer 4 []) Source Private Required), Z_eff: (Variable 16 Z_eff Local () () Default (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 16 size () [(Var 16 R)] [] (Integer 4 []) () ()))]) Source Private Required), alpha: (Variable 16 alpha Local () () Default (Real 8 []) Source Private Required), beta: (Variable 16 beta Local () () Default (Real 8 []) Source Private Required), cut: (Variable 16 cut In () () Default (Logical 4 []) Source Private Optional), exp: (ExternalSymbol 16 exp 35 exp lfortran_intrinsic_math2 exp Private), exp@dexp: (ExternalSymbol 16 exp@dexp 35 dexp lfortran_intrinsic_math2 dexp Private), gamma: (Variable 16 gamma Local () () Default (Real 8 []) Source Private Required), size: (ExternalSymbol 16 size 18 size lfortran_intrinsic_array size Private), sqrt: (ExternalSymbol 16 sqrt 35 sqrt lfortran_intrinsic_math2 sqrt Private), sqrt@dsqrt: (ExternalSymbol 16 sqrt@dsqrt 35 dsqrt lfortran_intrinsic_math2 dsqrt Private), x: (Variable 16 x Local () () Default (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 16 size () [(Var 16 R)] [] (Integer 4 []) () ()))]) Source Private Required)}) thomas_fermi_potential [(Var 16 R) (Var 16 Z) (Var 16 cut)] [(= (Var 16 x) (BinOp (Var 16 R) Mul (BinOp (BinOp (ImplicitCast (BinOp (ConstantInteger 128 (Integer 4 [])) Mul (Var 16 Z) (Integer 4 []) ()) IntegerToReal (Real 8 []) ()) Div (BinOp (ImplicitCast (ConstantInteger 9 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 9.000000 (Real 8 []))) Mul (BinOp (Var 2 pi) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) (ConstantReal 9.869604 (Real 8 []))) (Real 8 []) (ConstantReal 88.826440 (Real 8 []))) (Real 8 []) ()) Pow (BinOp (ConstantReal 1.000000 (Real 8 [])) Div (ImplicitCast (ConstantInteger 3 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 3.000000 (Real 8 []))) (Real 8 []) (ConstantReal 0.333333 (Real 8 []))) (Real 8 []) ()) (Real 8 [(() ())]) ())) (= (Var 16 alpha) (ConstantReal 0.728064 (Real 8 []))) (= (Var 16 beta) (UnaryOp USub (ConstantReal 0.543079 (Real 8 [])) (Real 8 []) (ConstantReal -0.543079 (Real 8 [])))) (= (Var 16 gamma) (ConstantReal 0.361216 (Real 8 []))) (= (Var 16 Z_eff) (BinOp (BinOp (ImplicitCast (Var 16 Z) IntegerToReal (Real 8 []) ()) Mul (BinOp (BinOp (BinOp (ImplicitCast (ConstantInteger 1 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 1.000000 (Real 8 []))) Add (BinOp (Var 16 alpha) Mul (FunctionCall 16 sqrt@dsqrt 16 sqrt [(Var 16 x)] [] (Real 8 []) () ()) (Real 8 []) ()) (Real 8 []) ()) Add (BinOp (BinOp (Var 16 beta) Mul (Var 16 x) (Real 8 []) ()) Mul (FunctionCall 16 exp@dexp 16 exp [(BinOp (UnaryOp USub (Var 16 gamma) (Real 8 []) ()) Mul (FunctionCall 16 sqrt@dsqrt 16 sqrt [(Var 16 x)] [] (Real 8 []) () ()) (Real 8 []) ())] [] (Real 8 []) () ()) (Real 8 []) ()) (Real 8 []) ()) Pow (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 8 []) (ConstantReal 2.000000 (Real 8 []))) (Real 8 []) ()) (Real 8 []) ()) Mul (FunctionCall 16 exp@dexp 16 exp [(BinOp (BinOp (ImplicitCast (UnaryOp USub (ConstantInteger 2 (Integer 4 [])) (Integer 4 []) (ConstantInteger -2 (Integer 4 []))) IntegerToReal (Real 8 []) (ConstantReal -2.000000 (Real 8 []))) Mul (Var 16 alpha) (Real 8 []) ()) Mul (FunctionCall 16 sqrt@dsqrt 16 sqrt [(Var 16 x)] [] (Real 8 []) () ()) (Real 8 []) ())] [] (Real 8 []) () ()) (Real 8 []) ())) (= (Var 16 V) (BinOp (UnaryOp USub (Var 16 Z_eff) (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 16 size () [(Var 16 R)] [] (Integer 4 []) () ()))]) ()) Div (Var 16 R) (Real 8 [((ConstantInteger 1 (Integer 4 [])) (FunctionCall 16 size () [(Var 16 R)] [] (Integer 4 []) () ()))]) ()))] (Var 16 V) Source Public Implementation)}) energies [types constants lfortran_intrinsic_array] .false.), iso_fortran_env: (IntrinsicModule lfortran_intrinsic_iso_fortran_env), lfortran_intrinsic_array: (IntrinsicModule lfortran_intrinsic_array), lfortran_intrinsic_kind: (IntrinsicModule lfortran_intrinsic_kind), lfortran_intrinsic_math2: (IntrinsicModule lfortran_intrinsic_math2), types: (Module (SymbolTable 4 {dp: (Variable 4 dp Local (FunctionCall 4 kind () [(ConstantReal 0.000000 (Real 8 []))] [] (Integer 4 []) (ConstantInteger 8 (Integer 4 [])) ()) (ConstantInteger 8 (Integer 4 [])) Parameter (Integer 4 []) Source Public Required), kind: (ExternalSymbol 4 kind 6 kind lfortran_intrinsic_kind kind Private)}) types [lfortran_intrinsic_kind] .true.)}) [])
    

    1c09a124 works for energies.f90 but adding log breaks it with:

    Traceback (most recent call last):
      Binary file "/users/home/rog32/Git/Github/Fortran/mylf/inst/bin/lfortran", in _start()
      Binary file "/lib64/libc.so.6", in __libc_start_main()
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/bin/lfortran.cpp", line 1328, in main()
        return compile_to_object_file(arg_file, outfile, false,
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/bin/lfortran.cpp", line 644, in compile_to_object_file()
        result = fe.get_asr2(input, fixed_form);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/codegen/evaluator.cpp", line 485, in LFortran::FortranEvaluator::get_asr2(std::__cxx11::basic_string<char, std::char_traits<char>, std::allocator<char> > const&, bool)
        asr = ast_to_asr(al, *ast, symbol_table);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_to_asr.cpp", line 36, in LFortran::ast_to_asr(Allocator&, LFortran::AST::TranslationUnit_t&, LFortran::SymbolTable*)
        ASR::TranslationUnit_t *tu = body_visitor(al, ast, unit);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 2070, in LFortran::body_visitor(Allocator&, LFortran::AST::TranslationUnit_t&, LFortran::ASR::asr_t*)
        b.visit_TranslationUnit(ast);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 44, in LFortran::BodyVisitor::visit_TranslationUnit(LFortran::AST::TranslationUnit_t const&)
        visit_ast(*x.m_items[i]);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4572, in LFortran::AST::BaseVisitor<LFortran::BodyVisitor>::visit_ast(LFortran::AST::ast_t const&)
        void visit_ast(const ast_t &b) { visit_ast_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4531, in void LFortran::AST::visit_ast_t<LFortran::BodyVisitor>(LFortran::AST::ast_t const&, LFortran::BodyVisitor&)
        case astType::mod: { v.visit_mod((const mod_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4575, in LFortran::AST::BaseVisitor<LFortran::BodyVisitor>::visit_mod(LFortran::AST::mod_t const&)
        void visit_mod(const mod_t &b) { visit_mod_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4185, in void LFortran::AST::visit_mod_t<LFortran::BodyVisitor>(LFortran::AST::mod_t const&, LFortran::BodyVisitor&)
        case modType::Module: { v.visit_Module((const Module_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 601, in LFortran::BodyVisitor::visit_Module(LFortran::AST::Module_t const&)
        visit_program_unit(*x.m_contains[i]);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4580, in LFortran::AST::BaseVisitor<LFortran::BodyVisitor>::visit_program_unit(LFortran::AST::program_unit_t const&)
        void visit_program_unit(const program_unit_t &b) { visit_program_unit_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4198, in void LFortran::AST::visit_program_unit_t<LFortran::BodyVisitor>(LFortran::AST::program_unit_t const&, LFortran::BodyVisitor&)
        case program_unitType::Function: { v.visit_Function((const Function_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 724, in LFortran::BodyVisitor::visit_Function(LFortran::AST::Function_t const&)
        this->visit_stmt(*x.m_body[i]);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4613, in LFortran::AST::BaseVisitor<LFortran::BodyVisitor>::visit_stmt(LFortran::AST::stmt_t const&)
        void visit_stmt(const stmt_t &b) { visit_stmt_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4324, in void LFortran::AST::visit_stmt_t<LFortran::BodyVisitor>(LFortran::AST::stmt_t const&, LFortran::BodyVisitor&)
        case stmtType::If: { v.visit_If((const If_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 1873, in LFortran::BodyVisitor::visit_If(LFortran::AST::If_t const&)
        visit_stmt(*x.m_orelse[i]);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4613, in LFortran::AST::BaseVisitor<LFortran::BodyVisitor>::visit_stmt(LFortran::AST::stmt_t const&)
        void visit_stmt(const stmt_t &b) { visit_stmt_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4285, in void LFortran::AST::visit_stmt_t<LFortran::BodyVisitor>(LFortran::AST::stmt_t const&, LFortran::BodyVisitor&)
        case stmtType::Assignment: { v.visit_Assignment((const Assignment_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 765, in LFortran::BodyVisitor::visit_Assignment(LFortran::AST::Assignment_t const&)
        this->visit_expr(*x.m_value);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4662, in LFortran::AST::BaseVisitor<LFortran::BodyVisitor>::visit_expr(LFortran::AST::expr_t const&)
        void visit_expr(const expr_t &b) { visit_expr_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/ast.h", line 4345, in void LFortran::AST::visit_expr_t<LFortran::BodyVisitor>(LFortran::AST::expr_t const&, LFortran::BodyVisitor&)
        case exprType::FuncCallOrArray: { v.visit_FuncCallOrArray((const FuncCallOrArray_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/semantics/ast_body_visitor.cpp", line 1243, in LFortran::BodyVisitor::visit_FuncCallOrArray(LFortran::AST::FuncCallOrArray_t const&)
        ASR::Module_t *m = LFortran::ASRUtils::load_module(al, current_scope->parent, module_name,
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_utils.cpp", line 111, in LFortran::ASRUtils::load_module(Allocator&, LFortran::SymbolTable*, std::__cxx11::basic_string<char, std::char_traits<char>, std::allocator<char> > const&, LFortran::Location const&, bool)
        ASR::TranslationUnit_t *mod1 = find_and_load_module(al, module_name,
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_utils.cpp", line 244, in LFortran::ASRUtils::find_and_load_module(Allocator&, std::__cxx11::basic_string<char, std::char_traits<char>, std::allocator<char> > const&, LFortran::SymbolTable&, bool)
        ASR::TranslationUnit_t *asr = load_modfile(al, modfile, false,
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/modfile.cpp", line 76, in LFortran::load_modfile(Allocator&, std::__cxx11::basic_string<char, std::char_traits<char>, std::allocator<char> > const&, bool, LFortran::SymbolTable&)
        ASR::asr_t *asr = deserialize_asr(al, asr_binary, load_symtab_id, symtab);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/serialization.cpp", line 358, in LFortran::deserialize_asr(Allocator&, std::__cxx11::basic_string<char, std::char_traits<char>, std::allocator<char> > const&, bool, LFortran::SymbolTable&)
        LFORTRAN_ASSERT(asr_verify(*tu, false));
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_verify.cpp", line 323, in LFortran::asr_verify(LFortran::ASR::TranslationUnit_t const&, bool)
        v.visit_TranslationUnit(unit);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_verify.cpp", line 95, in LFortran::ASR::VerifyVisitor::visit_TranslationUnit(LFortran::ASR::TranslationUnit_t const&)
        this->visit_symbol(*a.second);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2016, in LFortran::ASR::BaseVisitor<LFortran::ASR::VerifyVisitor>::visit_symbol(LFortran::ASR::symbol_t const&)
        void visit_symbol(const symbol_t &b) { visit_symbol_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 1872, in void LFortran::ASR::visit_symbol_t<LFortran::ASR::VerifyVisitor>(LFortran::ASR::symbol_t const&, LFortran::ASR::VerifyVisitor&)
        case symbolType::Module: { v.visit_Module((const Module_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_verify.cpp", line 142, in LFortran::ASR::VerifyVisitor::visit_Module(LFortran::ASR::Module_t const&)
        this->visit_symbol(*a.second);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2016, in LFortran::ASR::BaseVisitor<LFortran::ASR::VerifyVisitor>::visit_symbol(LFortran::ASR::symbol_t const&)
        void visit_symbol(const symbol_t &b) { visit_symbol_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 1874, in void LFortran::ASR::visit_symbol_t<LFortran::ASR::VerifyVisitor>(LFortran::ASR::symbol_t const&, LFortran::ASR::VerifyVisitor&)
        case symbolType::Function: { v.visit_Function((const Function_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_verify.cpp", line 197, in LFortran::ASR::VerifyVisitor::visit_Function(LFortran::ASR::Function_t const&)
        visit_stmt(*x.m_body[i]);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2027, in LFortran::ASR::BaseVisitor<LFortran::ASR::VerifyVisitor>::visit_stmt(LFortran::ASR::stmt_t const&)
        void visit_stmt(const stmt_t &b) { visit_stmt_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 1899, in void LFortran::ASR::visit_stmt_t<LFortran::ASR::VerifyVisitor>(LFortran::ASR::stmt_t const&, LFortran::ASR::VerifyVisitor&)
        case stmtType::If: { v.visit_If((const If_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2224, in LFortran::ASR::BaseWalkVisitor<LFortran::ASR::VerifyVisitor>::visit_If(LFortran::ASR::If_t const&)
        self().visit_stmt(*x.m_body[i]);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2027, in LFortran::ASR::BaseVisitor<LFortran::ASR::VerifyVisitor>::visit_stmt(LFortran::ASR::stmt_t const&)
        void visit_stmt(const stmt_t &b) { visit_stmt_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 1890, in void LFortran::ASR::visit_stmt_t<LFortran::ASR::VerifyVisitor>(LFortran::ASR::stmt_t const&, LFortran::ASR::VerifyVisitor&)
        case stmtType::Assignment: { v.visit_Assignment((const Assignment_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2185, in LFortran::ASR::BaseWalkVisitor<LFortran::ASR::VerifyVisitor>::visit_Assignment(LFortran::ASR::Assignment_t const&)
        self().visit_expr(*x.m_value);
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 2052, in LFortran::ASR::BaseVisitor<LFortran::ASR::VerifyVisitor>::visit_expr(LFortran::ASR::expr_t const&)
        void visit_expr(const expr_t &b) { visit_expr_t(b, self()); }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr.h", line 1924, in void LFortran::ASR::visit_expr_t<LFortran::ASR::VerifyVisitor>(LFortran::ASR::expr_t const&, LFortran::ASR::VerifyVisitor&)
        case exprType::FunctionCall: { v.visit_FunctionCall((const FunctionCall_t &)x); return; }
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_verify.cpp", line 285, in LFortran::ASR::VerifyVisitor::visit_FunctionCall(LFortran::ASR::FunctionCall_t const&)
        require(symtab_in_scope(current_symtab,
      File "/users/home/rog32/Git/Github/Fortran/mylf/src/lfortran/asr_verify.cpp", line 72, in LFortran::ASR::VerifyVisitor::symtab_in_scope(LFortran::SymbolTable const*, unsigned int)
        if( der_sym->type == ASR::symbolType::DerivedType) {
      File "sigaction.c", line 0, in .annobin_sigaction.c()
    Segfault: Signal SIGSEGV (segmentation fault) received
    make[2]: *** [CMakeFiles/F_atom_U.dir/build.make:244: CMakeFiles/F_atom_U.dir/energies.f90.o] Error 1
    make[1]: *** [CMakeFiles/Makefile2:83: CMakeFiles/F_atom_U.dir/all] Error 2
    make: *** [Makefile:91: all] Error 2
    Edited by Rohit Goswami
  • Author Developer

    Won't fix for this MR (rewriting source)

  • mentioned in issue #527 (closed)

  • Rohit Goswami mentioned in merge request !1225 (closed)

    mentioned in merge request !1225 (closed)

  • Rohit Goswami added 59 commits

    added 59 commits

    • 6bcaf7be...8eafd253 - 42 commits from branch lfortran:master
    • 824b3dfe - abs: Implement for integer arguments [runtime]
    • c05aaddd - ast_visitors: Restructure to reduce duplication
    • 4bb843d5 - floor: Hacky implementation [runtime]
    • e157b1b2 - exp: Very rough approximation [runtime]
    • 096236e1 - ast: Lookup exp
    • ec3c8326 - exp: Work tentatively [runtime]
    • 42f9f99c - exp: x>floor(x), use [0,1] [runtime]
    • ad38747a - exp: Clean and fix gfortran errors
    • 5d6b2dd5 - sign: Implement rough draft [runtime]
    • ab33a826 - ast: Recognize sign
    • 46fcaa1b - exp: Use ** [runtime]
    • 46c47a7c - exp: Fixup to get reasonable values [runtime]
    • 18d4c388 - test: Generate basic scaffold
    • 15a84292 - test: Update ranges
    • 082de277 - log: Worst approximation [runtime]
    • bc8eeec0 - ast: Recognize log
    • 6089b745 - log: Clean

    Compare with previous version

  • Loading
  • Loading
  • Loading
  • Loading
  • Loading
  • Loading
  • Loading
  • Loading
  • Loading
  • Loading
Please register or sign in to reply
Loading