def fix_subroutine_uses_clauses(tree, types):
"""Walk over all nodes in tree, updating subroutine uses
clauses to include the parent module and all necessary
modules from types
Also rename any arguments that clash with module names.
"""
for mod, sub, arguments in ft.walk_procedures(tree):
sub.uses = set()
sub.mod_name = None
if mod is not None:
sub_name = sub.name
if hasattr(sub, 'call_name'):
sub_name = sub.call_name
sub.uses.add((mod.name, (sub_name, )))
sub.mod_name = mod.name
for arg in arguments:
if arg.type.startswith('type') and ft.strip_type(
arg.type) in types:
sub.uses.add((types[ft.strip_type(arg.type)].mod_name,
(ft.strip_type(arg.type), )))
for mod, sub, arguments in ft.walk_procedures(tree):
for arg in arguments:
for (mod_name, type_name) in sub.uses:
if arg.name == mod_name:
arg.name += '_'
return tree
def fix_subroutine_uses_clauses(tree, types):
"""Walk over all nodes in tree, updating subroutine uses
clauses to include the parent module and all necessary
modules from types
Also rename any arguments that clash with module names.
"""
for mod, sub, arguments in ft.walk_procedures(tree):
sub.uses = set()
sub.mod_name = None
if mod is not None:
sub_name = sub.name
if hasattr(sub, 'call_name'):
sub_name = sub.call_name
sub.uses.add((mod.name, (sub_name,)))
sub.mod_name = mod.name
for arg in arguments:
if arg.type.startswith('type') and ft.strip_type(arg.type) in types:
sub.uses.add((types[ft.strip_type(arg.type)].mod_name, (ft.strip_type(arg.type),)))
for mod, sub, arguments in ft.walk_procedures(tree):
for arg in arguments:
for (mod_name, type_name) in sub.uses:
if arg.name == mod_name:
arg.name += '_'
return tree
def convert_derived_type_arguments(tree, init_lines, sizeof_fortran_t):
for mod, sub, arguments in ft.walk_procedures(tree, include_ret_val=True):
sub.types = set()
sub.transfer_in = []
sub.transfer_out = []
sub.allocate = []
sub.deallocate = []
if 'constructor' in sub.attributes:
sub.arguments[0].attributes = set_intent(
sub.arguments[0].attributes, 'intent(out)')
if 'destructor' in sub.attributes:
logging.debug('deallocating arg "%s" in %s' %
(sub.arguments[0].name, sub.name))
sub.deallocate.append(sub.arguments[0].name)
for arg in arguments:
if not hasattr(arg, 'type') or not arg.type.startswith('type'):
continue
# save original Fortran intent since we'll be overwriting it
# with intent of the opaque pointer
arg.attributes = arg.attributes + [
'fortran_' + attr
for attr in arg.attributes if attr.startswith('intent')
]
typename = ft.strip_type(arg.type)
arg.wrapper_type = 'integer'
arg.wrapper_dim = sizeof_fortran_t
sub.types.add(typename)
if typename in init_lines:
use, (exe, exe_optional) = init_lines[typename]
if use is not None:
sub.uses.add((use, [typename]))
arg.init_lines = (exe_optional, exe)
if 'intent(out)' in arg.attributes:
arg.attributes = set_intent(arg.attributes, 'intent(out)')
sub.transfer_out.append(arg.name)
if 'pointer' not in arg.attributes:
logging.debug('allocating arg "%s" in %s' %
(arg.name, sub.name))
sub.allocate.append(arg.name)
else:
arg.attributes = set_intent(arg.attributes, 'intent(in)')
sub.transfer_in.append(arg.name)
return tree
def convert_array_intent_out_to_intent_inout(tree):
"""
Find all intent(out) array arguments and convert to intent(inout)
"""
for mod, sub, arguments in ft.walk_procedures(tree, include_ret_val=True):
for arg in arguments:
dims = [attr for attr in arg.attributes if attr.startswith('dimension') ]
if dims == []:
continue
if len(dims) != 1:
raise ValueError('more than one dimension attribute found for arg %s' % arg.name)
if 'intent(out)' in arg.attributes:
arg.attributes = set_intent(arg.attributes, 'intent(inout)')
return tree
def convert_derived_type_arguments(tree, init_lines, sizeof_fortran_t):
for mod, sub, arguments in ft.walk_procedures(tree, include_ret_val=True):
sub.types = set()
sub.transfer_in = []
sub.transfer_out = []
sub.allocate = []
sub.deallocate = []
if 'constructor' in sub.attributes:
sub.arguments[0].attributes = set_intent(sub.arguments[0].attributes, 'intent(out)')
if 'destructor' in sub.attributes:
logging.debug('deallocating arg "%s" in %s' % (sub.arguments[0].name, sub.name))
sub.deallocate.append(sub.arguments[0].name)
for arg in arguments:
if not hasattr(arg, 'type') or not arg.type.startswith('type'):
continue
# save original Fortran intent since we'll be overwriting it
# with intent of the opaque pointer
arg.attributes = arg.attributes + ['fortran_' + attr for attr in
arg.attributes if attr.startswith('intent')]
typename = ft.strip_type(arg.type)
arg.wrapper_type = 'integer'
arg.wrapper_dim = sizeof_fortran_t
sub.types.add(typename)
if typename in init_lines:
use, (exe, exe_optional) = init_lines[typename]
if use is not None:
sub.uses.add((use, [typename]))
arg.init_lines = (exe_optional, exe)
if 'intent(out)' in arg.attributes:
arg.attributes = set_intent(arg.attributes, 'intent(out)')
sub.transfer_out.append(arg.name)
if 'pointer' not in arg.attributes:
logging.debug('allocating arg "%s" in %s' % (arg.name, sub.name))
sub.allocate.append(arg.name)
else:
arg.attributes = set_intent(arg.attributes, 'intent(in)')
sub.transfer_in.append(arg.name)
return tree
def fix_subroutine_uses_clauses(tree, types):
"""Walk over all nodes in tree, updating subroutine uses
clauses to include the parent module and all necessary
modules from types"""
for mod, sub, arguments in ft.walk_procedures(tree):
sub.uses = set()
sub.mod_name = None
if mod is not None:
sub.uses.add((mod.name, (sub.name,)))
sub.mod_name = mod.name
for arg in arguments:
if arg.type.startswith('type') and arg.type in types:
sub.uses.add((types[arg.type].mod_name, (ft.strip_type(arg.type),)))
return tree
def fix_subroutine_uses_clauses(tree, types):
"""Walk over all nodes in tree, updating subroutine uses
clauses to include the parent module and all necessary
modules from types"""
for mod, sub, arguments in ft.walk_procedures(tree):
sub.uses = set()
sub.mod_name = None
if mod is not None:
sub.uses.add((mod.name, (sub.name, )))
sub.mod_name = mod.name
for arg in arguments:
if arg.type.startswith('type') and arg.type in types:
sub.uses.add(
(types[arg.type].mod_name, (ft.strip_type(arg.type), )))
return tree
def convert_array_intent_out_to_intent_inout(tree):
"""
Find all intent(out) array arguments and convert to intent(inout)
"""
for mod, sub, arguments in ft.walk_procedures(tree, include_ret_val=True):
for arg in arguments:
dims = [
attr for attr in arg.attributes if attr.startswith('dimension')
]
if dims == []:
continue
if len(dims) != 1:
raise ValueError(
'more than one dimension attribute found for arg %s' %
arg.name)
if 'intent(out)' in arg.attributes:
arg.attributes = set_intent(arg.attributes, 'intent(inout)')
return tree
def fix_subroutine_uses_clauses(tree, types, kinds):
"""Walk over all nodes in tree, updating subroutine uses
clauses to include the parent module and all necessary modules
from types and kinds."""
for mod, sub, arguments in ft.walk_procedures(tree):
logging.info('fix_subroutine_uses_clauses %s' % sub.name)
sub.uses = set()
sub.mod_name = None
if mod is not None:
sub.uses.add((mod.name, None))
sub.mod_name = mod.name
for arg in arguments:
if arg.type.startswith('type') and arg.type in types:
sub.uses.add((types[arg.type].mod_name, None))
for (mod, only) in kinds:
if mod not in sub.uses:
sub.uses.add((mod, only))
return tree
def fix_subroutine_uses_clauses(tree, types, kinds):
"""Walk over all nodes in tree, updating subroutine uses
clauses to include the parent module and all necessary modules
from types and kinds."""
for mod, sub, arguments in ft.walk_procedures(tree):
logging.info('fix_subroutine_uses_clauses %s' % sub.name)
sub.uses = set()
sub.mod_name = None
if mod is not None:
sub.uses.add((mod.name, None))
sub.mod_name = mod.name
for arg in arguments:
if arg.type.startswith('type') and arg.type in types:
sub.uses.add((types[arg.type].mod_name, None))
for (mod, only) in kinds:
if mod not in sub.uses:
sub.uses.add((mod, only))
return tree
