[Arjen Markus] (6 april 2021) My two favourite programming languages are
Tcl and Fortran. [Jim], as an implementation of Tcl that has a smaller
footprint, has attracted my attention from time to time and recently I
was inspired to create an interface between Fortran and Jimtcl, based on
the interfacing facilities offered by the Fortran 2003 standard.

The technique consists of providing formal interfaces on the Fortran
side to the C API. The result is that almost the entire interface can be
defined in Fortran. As an illustration find below the complete source
for a rather limited set of Jim functions. It is enough to create a Jim
interpreter and register new commands, thus providing scripting
facilities.

Note: the code below can and should be improved. Right now there is too
much "C" visible, such as the kind parameters `c_int` etc. Also, it
would be better to have specific types for the interpreter pointer
(`interp`) and the pointers to JimObj objects. Some C code is needed to
make the various macros accessible, notably `Jim_IncrRefCount` and the
like. And some generic interfaces, because `Jim_GetLong` resembles
`Jim_GetDouble` a lot.


======
! fjim.f90 --
!     Interface to the Jim library
!
module fjim
    use iso_c_binding
    implicit none

    integer, parameter :: jim_ok     = 0
    integer, parameter :: jim_err    = 1
    integer, parameter :: jim_return = 2
    integer, parameter :: jim_break  = 3

interface
    function Jim_CreateInterp() bind(C, name = 'Jim_CreateInterp')
        import :: c_ptr
        type(c_ptr) :: Jim_CreateInterp
    end function Jim_CreateInterp
end interface

interface
    subroutine Jim_FreeInterp( interp ) bind(C, name = 'Jim_FreeInterp')
        import :: c_ptr
        type(c_ptr), value :: interp
    end subroutine Jim_FreeInterp
end interface

interface
    subroutine Jim_RegisterCoreCommands( interp ) bind(C, name = 'Jim_RegisterCoreCommands')
        import :: c_ptr
        type(c_ptr), value :: interp
    end subroutine Jim_RegisterCoreCommands
end interface

interface
    subroutine Jim_InitStaticExtensions( interp ) bind(C, name = 'Jim_InitStaticExtensions')
        import :: c_ptr
        type(c_ptr), value :: interp
    end subroutine Jim_InitStaticExtensions
end interface

interface
    subroutine Jim_Eval_c( interp, string ) bind(C, name = 'Jim_Eval')
        import :: c_ptr
        type(c_ptr), value             :: interp
        character(len=1), dimension(*) :: string
    end subroutine Jim_Eval_c
end interface

interface
    subroutine Jim_CreateCommand_c( interp, string, funcptr, privdata, delptr ) bind(C, name = 'Jim_CreateCommand')
        import :: c_ptr, c_funptr
        type(c_ptr), value             :: interp
        character(len=1), dimension(*) :: string
        type(c_funptr), value          :: funcptr
        type(c_ptr), value             :: privdata
        type(c_funptr), value          :: delptr
    end subroutine Jim_CreateCommand_c
end interface

interface
    integer function Jim_GetLong( interp, objptr, value ) bind(C, name = 'Jim_GetLong')
        import :: c_ptr, c_long
        type(c_ptr), value                  :: interp
        type(c_ptr), value                  :: objptr
        integer(kind=c_long), intent(inout) :: value
    end function Jim_GetLong
end interface

interface
    integer function Jim_GetDouble( interp, objptr, value ) bind(C, name = 'Jim_GetDouble')
        import :: c_ptr, c_double
        type(c_ptr), value                  :: interp
        type(c_ptr), value                  :: objptr
        real(kind=c_double), intent(inout)  :: value
    end function Jim_GetDouble
end interface
interface
    function Jim_GetString_c( objptr, length ) bind(C, name = 'Jim_GetString')
        import :: c_ptr, c_int
        type(c_ptr), value                  :: objptr
        integer(kind=c_int), intent(out)    :: length
        type(c_ptr)                         :: Jim_GetString_c
    end function Jim_GetString_c
end interface

contains

! jim_newinterp --
!     Create a new Jim interpreter
!
! Arguments:
!     interp           Pointer to the interpreter structure
!
subroutine jim_newinterp( interp )
    type(c_ptr), intent(out) :: interp

    interp = Jim_CreateInterp()

    call Jim_RegisterCoreCommands( interp )
    call Jim_InitStaticExtensions( interp )

end subroutine jim_newinterp

subroutine jim_deleteinterp( interp )
    type(c_ptr), intent(in) :: interp

    call Jim_FreeInterp( interp )

end subroutine jim_deleteinterp

subroutine jim_eval( interp, string )
    type(c_ptr), intent(in)      :: interp
    character(len=*), intent(in) :: string

    call Jim_Eval_c( interp, string // c_null_char )
end subroutine jim_eval

! jim_createcommand --
!     Create a new command
!
! Arguments:
!     interp             Jim interpreter
!     cmdname            Name of the command
!     cmdptr             Function that implements the command
!
! Note:
!     Other arguments suppressed for the moment
!
subroutine jim_createcommand( interp, cmdname, cmdptr )  !!, privdata, delptr )
    type(c_ptr), intent(in)      :: interp
    character(len=*), intent(in) :: cmdname
    interface
        integer function cmdptr( interp, argc, argv )
            import :: c_ptr
            type(c_ptr), value        :: interp
            integer, value            :: argc
            type(c_ptr), dimension(*) :: argv
        end function cmdptr
    end interface

    call Jim_CreateCommand_c( interp, trim(cmdname) // c_null_char, c_funloc(cmdptr), c_null_ptr, c_null_funptr )

end subroutine jim_createcommand

! jim_getstring --
!     Get the string represntation from a JimObj object
!
! Arguments:
!     interp           Pointer to the interpreter structure
!     objptr           Pointer to the JimObj object in question
!
! Return value:
!     Pointer to the string
!
function jim_getstring( objptr )
    type(c_ptr), intent(in)               :: objptr
    character(kind=c_char,len=:), pointer :: jim_getstring

    type(c_ptr)                           :: c_string
    integer(kind=c_int)                   :: length

    c_string = jim_getstring_c( objptr, length )

    block
        character(kind=c_char, len=length), pointer :: t_string

        call c_f_pointer( c_string, t_string )
        jim_getstring => t_string
        t_string      => null()
    end block

end function jim_getstring

end module fjim

module mycommands
    use fjim

    implicit none

contains
integer function myputs( interp, argc, argv )
    type(c_ptr), value        :: interp
    integer, value            :: argc
    type(c_ptr), dimension(*) :: argv

    integer                   :: i
    integer(kind=c_long_long) :: ivalue
    real(kind=c_double)       :: dvalue

    write(*,*) 'Number of arguments: ', argc

    do i = 1,argc
        if ( jim_getlong( interp, argv(i), ivalue ) == jim_ok ) then
            write(*,*) i, ': ', ivalue
        elseif ( jim_getdouble( interp, argv(i), dvalue ) == jim_ok ) then
            write(*,*) i, ': ', dvalue
        else
            write(*,*) i, ': ', jim_getstring( argv(i) )
        endif
    enddo

end function myputs

end module mycommands

! test --
!     Simple test, copy of the "jim_hello.c" program
!
program test_fjim
    use fjim
    use mycommands

    implicit none

    type(c_ptr) :: interp

    call jim_newinterp( interp )

    call jim_createcommand( interp, "printargs", myputs )

    call jim_eval( interp, 'puts "Hello, world!"' )

    call jim_eval( interp, 'printargs 2 "Hello, world!" 3.1415926' )

    call jim_deleteinterp( interp )

end program test_fjim
======

I built it using Cygwim on Windows, using:
======
gfortran -o demo fjim.f90 libjim.a
======

and the output of the program is:
======
Hello, world!
 Number of arguments:            4
           1 : printargs
           2 :                     2
           3 : Hello, world!
           4 :    3.1415926000000001
======

<<categories>> Jim | Example | Foreign Interfaces