Passage de tableaux à lua en tant qu'argument de fonction de Fortran

Question

Je cherche des exemples Fortran (également fonction d'interface) pour passer des tableaux comme arguments aux fonctions lua. J'ai été en mesure d'utiliser fortlua project pour commencer. Mais l'exemple fourni passe un élément à la fois. Appréciez toute aide.

--Lua code 

local q1 
local q2 
function getoutput(qout1, qout2) 
-- qout1 and qout2 are arrays with some dimension 
    q1 = qout1 
    q2 = qout2 
end 

- Fortran I utilisé

config_function('getoutput', args, 2, cstatus) 

Mais la définition des args est là où je suis à la recherche d'un peu d'aide. Le code suivant fait le travail pour la variable d'argument scalaire pas un tableau je devine.

!> Evaluate a function in the config file and get its result. 
FUNCTION config_function(name,args,nargs,status) 
    REAL :: config_function 
    CHARACTER(LEN=*) :: name 
    REAL, DIMENSION(nargs) :: args 
    REAL(KIND=c_double) :: anarg 
    INTEGER :: nargs 
    INTEGER :: status 
    INTEGER :: iargs 
    INTEGER(c_int) :: stackstart 

    stackstart = lua_gettop(mluastate) 

    config_function = 0 
    status = 0 


    CALL lua_getglobal(mluastate,TRIM(name)//C_NULL_CHAR) 
    IF (lua_type(mluastate,-1) .eq. LUA_TFUNCTION) THEN 
     DO iargs = 1,nargs 
      anarg = args(iargs) 
      CALL lua_pushnumber(mluastate,anarg) 
     ENDDO 
     IF (lua_pcall(mluastate,nargs,1,0) .eq. 0) THEN 
      if (lua_isnumber(mluastate,-1) .ne. 0) THEN 
      config_function = lua_tonumber(mluastate,-1) 
      CALL lua_settop(mluastate,-2) 
      ELSE 
      ! Nothing to pop here 
      status=-3 
      ENDIF 
     ELSE 
      CALL lua_settop(mluastate,-2) 
      status=-2 
     ENDIF 
    ELSE 
     CALL lua_settop(mluastate,-2) 
     status=-1 
    ENDIF 
    IF (stackstart .ne. lua_gettop(mluastate)) THEN 
     WRITE(*,*) 'The stack is a different size coming out of config_function' 
    ENDIF 
END FUNCTION config_function 

Answer 1

Pour développer un peu sur mon commentaire, voici un petit programme mettant en oeuvre un argument de tableau avec l'aide de Aotus:

program aot_vecarg_test 
    use flu_binding, only: flu_State, flu_settop 

    use aotus_module, only: open_config_file, close_config 
    use aot_fun_module, only: aot_fun_type, aot_fun_do, & 
    &      aot_fun_put, aot_fun_open, & 
    &      aot_fun_close 
    use aot_references_module, only: aot_reference_for, aot_reference_to_top 
    use aot_table_module, only: aot_table_open, aot_table_close, & 
    &       aot_table_from_1Darray 

    implicit none 

    type(flu_State) :: conf 
    type(aot_fun_type) :: luafun 
    integer :: iError 
    character(len=80) :: ErrString 
    real :: args(2) 
    integer :: argref 
    integer :: arghandle 

    args(1) = 1.0 
    args(2) = 2.0 

    call create_script('aot_vecarg_test_config.lua') 
    write(*,*) 
    write(*,*) 'Running aot_vecarg_test...' 
    write(*,*) ' * open_config_file (aot_vecarg_test_config.lua)' 
    call open_config_file(L = conf, filename = 'aot_vecarg_test_config.lua', & 
    &     ErrCode = iError, ErrString = ErrString) 
    if (iError /= 0) then 
    write(*,*) ' : unexpected FATAL Error occured !!!' 
    write(*,*) ' : Could not open the config file aot_ref_test_config.lua:' 
    write(*,*) trim(ErrString) 
    STOP 
    end if 
    write(*,*) ' : success.' 

    ! Create a table with data 
    call aot_table_from_1Darray(L  = conf,  & 
    &       thandle = arghandle, & 
    &       val  = args  ) 
    ! Create a reference to this table 
    call flu_setTop(L = conf, n = arghandle) 
    argref = aot_reference_for(L = conf) 

    ! Start the processing of the function 
    call aot_fun_open(L = conf, fun = luafun, key = 'print_array') 
    ! Put the previously defined table onto the stack by using the reference 
    call aot_reference_to_top(L = conf, ref = argref) 
    ! Put the top of the stack to the argument list of the Lua function 
    call aot_fun_put(L = conf, fun = luafun) 
    ! Execute the Lua function 
    call aot_fun_do(L = conf, fun = luafun, nresults = 0) 
    call aot_fun_close(L = conf, fun = luafun) 

    write(*,*) ' * close_conf' 
    call close_config(conf) 
    write(*,*) ' : success.' 
    write(*,*) '... Done with aot_vecarg_test.' 
    write(*,*) 'PASSED' 

contains 

    subroutine create_script(filename) 
    character(len=*) :: filename 

    open(file=trim(filename), unit=22, action='write', status='replace') 
    write(22,*) '-- test script for vectorial argument' 
    write(22,*) 'function print_array(x)' 
    write(22,*) ' for i, num in ipairs(x) do' 
    write(22,*) ' print("Lua:"..num)' 
    write(22,*) ' end' 
    write(22,*) 'end' 
    close(22) 
    end subroutine create_script 

end program aot_vecarg_test 

Cela rend l'utilisation d'un petit coup de routine aot_table_from_1Darray qui crée un Lua table pour un tableau de nombres réels. Jetez un oeil à son code pour voir comment les données peuvent être mises dans une table.

Nous créons ensuite une référence à cette table pour la rechercher facilement plus tard et la passer en argument à la fonction Lua. L'exemple crée le script Lua correspondant, qui définit une fonction simple qui attend une seule table en entrée et imprime chacune des entrées de la table. L'exécution de cette donne le résultat suivant:

Running aot_vecarg_test... 
    * open_config_file (aot_vecarg_test_config.lua) 
    : success. 
Lua:1.0 
Lua:2.0 
    * close_conf 
    : success. 
... Done with aot_vecarg_test. 
PASSED 

Lorsque les deux lignes commençant par Lua sont écrits par la fonction Lua print_array.

Il existe d'autres solutions possibles, mais j'espère que cela donne au moins une idée sur la façon dont cela pourrait être fait. Nous pourrions également penser à étendre l'interface aot_fun_put pour prendre soin des tableaux lui-même.