module sic_macros_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces
  use sic_structures
  !---------------------------------------------------------------------
  ! Support module for macros
  ! ---
  ! Note on the module name: the suffix '_interfaces' allows to ignore
  ! the 'use sic_macros_interfaces' line in all subroutines using this
  ! statement. This solves a false positive circular dependency:
  ! the sic_interfaces module is compiled first, then the current module.
  !---------------------------------------------------------------------
  !
  public :: macnam,macarg,manarg,mac1,mac2
  public :: sic_macros_variables,sic_macros_replace_args
  public :: sic_macros_parse,sic_macros_parse_reset
  private
  !
  character(len=filename_length) :: macnam(maxlev)            ! Name of all macros
  character(len=1024)            :: macarg(0:maxlev)          ! Arguments (command-line) of all macros
  integer(kind=4), save          :: manarg(0:maxlev)          ! Number of arguments of all macros
  integer(kind=4)                :: mac1(0:maxlev,maxmacarg)  ! Pointer to beginning of macro argument
  integer(kind=4)                :: mac2(0:maxlev,maxmacarg)  ! Pointer to end of argument of Macro
  character(len=256), save       :: macstr(maxmacarg)         ! Placeholder for arguments of CURRENT LEVEL macro (PRO%ARG[])
  !
  ! PRO%PARSE support
  type :: pro_parse_t  ! Support type for 1 macro command-line parsing
    logical                       :: do=.false.            ! Parsing enabled for this macro
    integer(kind=4)               :: nopt                  ! Number of options parsed
    character(len=command_length) :: optname(0:maxmacarg)  ! Parsed option names
    integer(kind=4)               :: optnarg(0:maxmacarg)  ! Number of options passed
    integer(kind=4)               :: optfirst(0:maxmacarg) ! Location of first argument of each option
  end type pro_parse_t
  !
  character(len=*), parameter :: parse_struct='PRO%PARSE'
  type(pro_parse_t), save     :: parse(maxlev)
  !
contains
  !
  subroutine sic_macros_variables
    !---------------------------------------------------------------------
    ! Define the current macro arguments in PRO%
    !---------------------------------------------------------------------
    logical :: error
    integer :: i
    !
    error = .false.
    call sic_delvariable ('PRO',.false.,error)
    if (nmacro.eq.0) return
    !
    ! This is a "Program Defined" structure
    error = .false.
    call sic_defstructure('PRO',.true.,error)
    !
    ! And now the associated program-defined variables.
    call sic_def_char('PRO%NAME',macnam(nmacro),.true.,error)
    call sic_def_inte('PRO%NARG',manarg(nmacro),0,0,.true.,error)
    if (manarg(nmacro) .lt.1) return
    call sic_def_charn('PRO%ARG',macstr,1,manarg(nmacro),.true.,error)
    do i = 1,manarg(nmacro)
      macstr(i) = macarg(nmacro)(mac1(nmacro,i):mac2(nmacro,i))
    enddo
    !
    ! The parse substructure (if relevant)
    call sic_macros_parse_variables(parse(nmacro),error)
    if (error)  return
  end subroutine sic_macros_variables
  !
  subroutine sic_macros_parse(line,error)
    !---------------------------------------------------------------------
    ! Support routine for command:
    !  SIC\PARSE [/OPT1 [Nargmin [Nargmax]]] [/OPT2 ...] ... [/OPTN ...]
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: line   ! Input command line
    logical,          intent(inout) :: error  ! Logical error flag
    !
    call sic_macros_parse_level(line,parse(nmacro),error)
    if (error)  return
    call sic_macros_parse_variables(parse(nmacro),error)
    if (error)  return
  end subroutine sic_macros_parse
  !
  subroutine sic_macros_parse_reset(imacro,error)
    !-------------------------------------------------------------------
    ! SIC\PARSE: reset the parse structure for the i-th macro
    !-------------------------------------------------------------------
    integer(kind=4), intent(in)    :: imacro
    logical,         intent(inout) :: error
    !
    parse(imacro)%do = .false.
    ! No more: the other components will be overwritten next time this
    ! level is used.
  end subroutine sic_macros_parse_reset
  !
  subroutine sic_macros_parse_level(line,p,error)
    !-------------------------------------------------------------------
    ! SIC\PARSE: parse and check the macros arguments for the current
    ! level
    !-------------------------------------------------------------------
    character(len=*),  intent(in)    :: line   ! Input command line
    type(pro_parse_t), intent(out)   :: p      !
    logical,           intent(inout) :: error  ! Logical error flag
    ! Local
    character(len=*), parameter :: rname='PARSE'
    integer(kind=4) :: nc,iopt,iarg,narg,curr_opt,spos
    character(len=command_length) :: imacstr,option
    integer(kind=4) :: nargmin(0:maxmacarg),nargmax(0:maxmacarg)
    character(len=32) :: mess1,mess2
    character(len=message_length) :: mess
    !
    ! --- Fetch the options list ---------------------------------------
    p%nopt = 0
    p%optname(p%nopt) = '/COMMAND'
    nargmin(p%nopt) = -1  ! No minimum provided yet
    nargmax(p%nopt) = -1  ! No maximum provided yet
    !
    do iarg=1,sic_narg(0)
      call sic_ch(line,0,iarg,option,nc,.true.,error)
      if (error)  return
      if (option(1:1).eq."/") then
        ! This is a new option declaration
        ! Finish previous option declaring
        if (nargmax(p%nopt).eq.-1)  nargmax(p%nopt) = nargmin(p%nopt)
        ! Start new option declaration
        call sic_upper(option)
        p%nopt = p%nopt+1
        p%optname(p%nopt) = option
        nargmin(p%nopt) = -1  ! No minimum provided yet
        nargmax(p%nopt) = -1  ! No maximum provided yet
        !
      elseif (nargmin(p%nopt).eq.-1) then
        call sic_i4(line,0,iarg,nargmin(p%nopt),.true.,error)
        if (error)  return
        if (nargmin(p%nopt).le.-1) then
          call sic_message(seve%e,rname,'Invalid option declaration, should have 0 <= Nargmin <= Nargmax')
          error = .true.
          return
        endif
        !
      elseif (nargmax(p%nopt).eq.-1) then
        call sic_i4(line,0,iarg,nargmax(p%nopt),.true.,error)
        if (error)  return
        if (nargmax(p%nopt).lt.nargmin(p%nopt)) then
          call sic_message(seve%e,rname,'Invalid option declaration, should have 0 <= Nargmin <= Nargmax')
          error = .true.
          return
        endif
        !
      else
        call sic_message(seve%e,rname,'Invalid option declaration. Syntax is:')
        call sic_message(seve%e,rname,'SIC\PARSE [Nargmin [Nargmax]] /OPT1  [Nargmin [Nargmax]] /OPT2...')
        error = .true.
        return
      endif
    enddo
    !
    ! --- Parse PRO%ARG --------------------------------------------------
    !
    p%optnarg(:) = -1  ! i.e. none of the options is present
    p%optnarg(0) = 0   ! i.e. command is present, with 0 argument yet
    p%optfirst(:) = 0  !
    p%optfirst(0) = 1  ! 1st argument of command is 1st element of PRO%ARG[:]
    curr_opt = 0
    do iarg=1,manarg(nmacro)
      spos = index(macstr(iarg),'/',back=.true.)
      if (macstr(iarg)(1:1).eq.'/' .and. spos.eq.1) then
        ! Argument starts with a slash and has no other slash =>
        ! must be an option to be compared with the PARSE ones.
        imacstr = macstr(iarg)
        call sic_upper(imacstr)
        call sic_ambigs(rname,imacstr,option,curr_opt,p%optname(1),p%nopt,error)
        if (error)  return
        p%optnarg(curr_opt) = 0
        p%optfirst(curr_opt) = iarg+1
      else
        ! Standard argument (including argument with several slashes,
        ! assumed to be paths): increment arguments counter for this option.
        p%optnarg(curr_opt) = p%optnarg(curr_opt)+1
      endif
    enddo
    !
    ! --- Check for correct number of arguments --------------------------
    !
    do iopt=0,p%nopt
      !
      if (p%optnarg(iopt).eq.-1)  cycle  ! Option is absent, nothing to check
      !
      if (nargmin(iopt).ne.-1 .and. nargmin(iopt).ne.nargmax(iopt)) then
        ! A minimum number is required
        if (p%optnarg(iopt).lt.nargmin(iopt)) then
          error = .true.
          mess2 = 'at least'
          narg = nargmin(iopt)
        endif
        !
      elseif (nargmax(iopt).ne.-1 .and. nargmin(iopt).ne.nargmax(iopt)) then
        ! A maximum number required
        if (p%optnarg(iopt).gt.nargmax(iopt)) then
          error = .true.
          mess2 = 'at most'
          narg = nargmax(iopt)
        endif
        !
      elseif (nargmin(iopt).ne.-1 .and. nargmin(iopt).eq.nargmax(iopt)) then
        ! An exact number is required
        if (p%optnarg(iopt).ne.nargmin(iopt)) then
          error = .true.
          mess2 = 'exactly'
          narg = nargmin(iopt)
        endif
      endif
      !
      if (error) then
        if (iopt.eq.0) then
          mess1 = 'Command'
        else
          mess1 = 'Option '//p%optname(iopt)
        endif
        write(mess,10)  trim(mess1),trim(mess2),narg
        call sic_message(seve%e,rname,mess)
        return
      endif
    enddo
    !
    ! --- Success ------------------------------------------------------
    ! Enable PRO%PARSE structure
    p%do = .true.
    !
  10 format(A,' takes ',A,1X,I0,' argument(s)')
  end subroutine sic_macros_parse_level
  !
  subroutine sic_macros_parse_variables(p,error)
    !-------------------------------------------------------------------
    ! SIC\PARSE: create the PRO%PARSE% structure
    !-------------------------------------------------------------------
    type(pro_parse_t), intent(in)    :: p
    logical,           intent(inout) :: error
    !
    integer(kind=4) :: iopt
    character(len=varname_length) :: varname1,varname2
    logical, parameter :: global=.true.,ro=.true.
    !
    call sic_delvariable(parse_struct,.false.,error)
    if (error)  return
    !
    if (.not.p%do)  return
    !
    call sic_defstructure(parse_struct,global,error)
    if (error)  return
    !
    do iopt=0,p%nopt
      !
      ! PRO%PARSE%<OPTNAME>%
      write(varname1,'(A,A,A)')  trim(parse_struct),'%',p%optname(iopt)(2:)  ! Strip the leading /
      call sic_defstructure(varname1,global,error)
      if (error)  return
      !
      ! PRO%PARSE%<OPTNAME>%NARG
      varname2 = trim(varname1)//'%NARG'
      call sic_def_inte(varname2,p%optnarg(iopt),0,0,ro,error)
      if (error)  return
      !
      ! PRO%PARSE%<OPTNAME>%ARG
      if (p%optnarg(iopt).gt.0) then
        ! Note: this assumes 'macstr' was updated by subroutine 'sic_macros_variables'
        varname2 = trim(varname1)//'%ARG'
        call sic_def_charn(varname2,macstr(p%optfirst(iopt)),1,p%optnarg(iopt),ro,error)
        if (error)  return
      endif
      !
    enddo
  end subroutine sic_macros_parse_variables
  !
  subroutine sic_macros_replace_args(line,nl,l,error)
    !---------------------------------------------------------------------
    !  Substitute the Macro Arguments invoked as tokens &1 ... &9
    !---------------------------------------------------------------------
    character(len=*), intent(inout) :: line   ! Line to be expanded
    integer(kind=4),  intent(inout) :: nl     ! Length of line
    integer(kind=4),  intent(in)    :: l      ! Macro number (0 == stack)
    logical,          intent(out)   :: error  ! Logical error flag
    ! Local
    integer(kind=4) :: nlm1,i,j,k,lv,ml,mv
    !
    error=.false.
    nlm1=nl-1
    ml = len(line)
    do i=nlm1,1,-1
      if (line(i:i).ne.'&') cycle    ! I
      ! This would no longer work if number of macro arguments is increased beyond 9
      k = ichar(line(i+1:i+1)) - ichar('0')
      if (k.lt.1 .or. k.gt.9) cycle  ! I
      if (mac1(l,k).eq.0 .or. len_trim(macarg(l)(mac1(l,k):mac2(l,k))).le.0) then
        ! No argument. Suppress &i
        if (line(i-1:i-1).eq.' '.and.line(i+2:i+2).eq.' ') then
          lv = -3                ! Was -3
        else
          lv = -2                ! Was -2
        endif
        !               line = line(1:i+lv+1) // line(i+2:)
        do j=i+2,nl,1
          line(j+lv:j+lv) = line(j:j)
        enddo
        line(nl+lv+1:nl) = ' '
        ! print *,"Line [",line(1:nl),"]",lv
      else                       ! Argument exists. Substitute
        lv = mac2(l,k)-mac1(l,k)-1
        !           line = line(1:i-1) // macarg(l)(mac1(l,k):mac2(l,k))
        !     +     // line(i+2:)
        if (lv.eq.0) then
          line(i:i+1) = macarg(l)(mac1(l,k):mac2(l,k))
        elseif (lv.lt.0) then
          line(i:i) = macarg(l)(mac1(l,k):mac2(l,k))
          do j=i+2,nl,1
            line(j+lv:j+lv) = line(j:j)
          enddo
          line(nl+lv+1:nl) = ' '
        else
          do j=nl,i+2,-1
            line(j+lv:j+lv) = line(j:j)
          enddo
          mv = min(i+lv+1,ml)
          line(i:mv) = macarg(l)(mac1(l,k):mac2(l,k))
        endif
      endif
      nl = nl+lv
      if (nl.gt.ml) then
        error=.true.
        return
      endif
    enddo                        ! I
  end subroutine sic_macros_replace_args
  !
end module sic_macros_interfaces
!
subroutine exemac(line,error)
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>exemac
  use sic_macros_interfaces
  !---------------------------------------------------------------------
  ! @ private
  ! SIC   Internal routine
  !       Execute a macro
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  logical,          intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MACRO'
  character(len=filename_length) :: name,fich
  integer :: i,n,ier,ipt,nc
  character(len=message_length) :: mess
  character(len=4) ::ans
  logical :: found
  !
  ! Increase execution level
  if (nlire.ge.maxlev-1) then
    call sic_message(seve%e,rname,'Input level too deep')
    error = .true.
    return
  endif
  !
  ! Find the macro name and setup the arguments
  error = .false.
  call sic_ch (line,0,1,name,nc,.true.,error)
  if (error) return
  call find_procedure(name,fich,found)
  if (.not.found) then
    call sic_message(seve%e,rname,'No such procedure '//name)
    error = .true.
    return
  endif
  !
  ! Check for recursive calls
  do i=1,nmacro
    if (macnam(i).eq.fich) then
      call sic_message(seve%e,rname,'Recursive call to macro '//fich)
      error = .true.
      return
    endif
  enddo
  !
  ! Get LUN
  call sic_lunmac_get(nmacro+1,error)
  if (error) return
  !
  ! Increment levels
  nlire   = nlire + 1
  nmacro  = nmacro + 1
  mlire(nlire) = nmacro
  !
  ! Open the file and proceed
  macnam(nmacro) = fich
  ier = sic_open(lunmac(nmacro),macnam(nmacro),'OLD',.true.)
  if (ier.ne.0) then
    call sic_message(seve%e,rname,'Unable to open macro '//fich)
    call putios('          ',ier)
    goto 70
  endif
  !
  ! Define the macro arguments
  call sic_macros_parse_reset(nmacro,error)
  if (error)  return
  ipt = 1
  macarg(nmacro) = ' '
  if (sic_present(0,maxmacarg+2)) then
    write (mess,'(A,I2,A)') 'Too many macro arguments. Only ',maxmacarg,  &
    ' will be used'
    call sic_message(seve%w,rname,mess)
  endif
  manarg(nmacro) = 0
  do i=1,maxmacarg
    if (sic_present(0,i+1)) then
      mac1(nmacro,i) = ipt
      call sic_ch (line,0,i+1,macarg(nmacro)(ipt:),nc,.true.,error)
      if (error) then
         close(unit=lunmac(nmacro))
         goto 70
      endif
      mac2(nmacro,i) = ipt + nc -1
      if (mac2(nmacro,i).lt.mac1(nmacro,i)) then
        mac2(nmacro,i) = mac1(nmacro,i)+sic_len(0,i+1)
      endif
      ipt = mac2(nmacro,i)+2
      manarg(nmacro) = i
    else
      mac1(nmacro,i) = 0
      mac2(nmacro,i) = 0
    endif
  enddo
  var_level = nmacro
  var_macro(var_level) = var_n
  jmac (nmacro) = 0
  nerr(var_level) = nerr(0)
  errcom(var_level) = errcom(0)
  !
  ! Define the arguments as SIC Variables
  call sic_macros_variables
  !
  if (sic_stepin.ne.0) then
    if (.not.lverif) then
      print *,'---- Executing @ '//trim(macnam(nmacro))
      print *,'----',manarg(nmacro),' arguments'
      print *,'----'//trim(macarg(nmacro))
      if (sic_stepin.lt.0) call sic_wprn('Continue ? ',ans,n)
    endif
  endif
  error = .false.
  return
  !
  ! Error : reset the execution level and number of active macros
  !
70 call sic_lunmac_free(nmacro)
  nmacro = nmacro - 1
  nlire = nlire -1
  error = .true.
end subroutine exemac
!
subroutine endmac
  use sic_macros_interfaces
  use sic_interfaces, except_this=>endmac
  use sic_structures
  !---------------------------------------------------------------------
  ! @ private
  ! End of macro execution
  !-----------------------------------------------------------------------
  !
  ! Close the unit and reset the active macro number
  close (unit=lunmac(nmacro))
  call sic_lunmac_free(nmacro)
  if (sic_stepin.ne.0) then
    print *,'---- Leaving @ '//trim(macnam(nmacro))
  endif
  errcom(nmacro) = ' '
  nerr  (nmacro) = 0
  nmacro = nmacro - 1
  !
  ! Delete all local variables :
  call erase_variables
  !
  ! Reset Arguments
  call sic_macros_variables
end subroutine endmac
