!# This source file is distributed with code Pégase.3.0.1 (2019-02-21).
!# Copyright: Michel Fioc (Michel.Fioc@iap.fr), Sorbonne université, 
!# Institut d'astrophysique de Paris/CNRS, France.
!# 
!# Pégase.3.0.1 is governed by the CeCILL license under French law and abides 
!# by the rules of distribution of free software. You can use, modify and/or 
!# redistribute this software under the terms of the CeCILL license as circulated 
!# by CEA, CNRS and INRIA at "http://www.cecill.info". The text of this license
!# is also available in French and in English in directory "doc_dir/" of this
!# code.
!# 
!# As a counterpart to the access to the source code and to the rights to copy,
!# modify and redistribute it granted by the license, users are provided only
!# with a limited warranty, and the software's author, the holder of the
!# economic rights, and the successive licensors have only limited
!# liability. 
!# 
!# The fact that you are presently reading this means that you have had
!# knowledge of the CeCILL license and that you accept its terms.
!#====================================================================== 

module mod_parse_file
  
  use mod_types

  implicit none
  private
  
!# Linked list of files.
  type :: struct_file_list
     integer :: unit
     character(len=std_string) :: file_name
     integer :: line_number
     logical :: included_file
     type(struct_file_list), pointer :: next => null()
  end type struct_file_list

  type(struct_file_list), pointer :: file_list => null()

  integer, parameter :: n_max_lines_per_statement = 10, &
       len_max_line = long_string, &
       len_max_statement = n_max_lines_per_statement*len_max_line

  public :: parse_file, file_list, struct_file_list, &
       len_max_statement, len_max_line

contains
  
!#======================================================================
  
  subroutine parse_file(file_list, read_proc, end_proc, &
       run, end_of_file, end_statement, return_statement, init_proc)

    use mod_strings, only : same_case_equal
    use mod_file_access, only : open_file, close_file
    use mod_analyze_statement, only : analyze_statement, file_name, &
         line_number, error_message
    
    implicit none
    external :: read_proc, end_proc !# ???
    type(struct_file_list), pointer :: file_list
    logical, intent(out) :: run, end_of_file, end_statement, return_statement
    external :: init_proc !# ???
    optional :: init_proc
    interface
       subroutine read_proc(key, rhs, indices_string, unknown_statement, &
            statement_type)
         use mod_strings, only : same_case_equal
         implicit none
         character(len=*), intent(in) :: key, rhs, statement_type
         character(len=*), intent(inout) :: indices_string
         logical, intent(out) :: unknown_statement
       end subroutine read_proc

       subroutine end_proc(run)
         use mod_strings, only : same_case_equal
         implicit none
         logical, intent(out) :: run
       end subroutine end_proc

       subroutine init_proc
         implicit none
       end subroutine init_proc
    end interface
!#......................................................................
    integer :: unit
    character(len=len_max_statement) :: statement
    character(len=len_max_line) :: line, processed_line
    integer :: len_line, len_statement, pos, quote, pos2, quote0
    logical :: incomplete_statement, other_statement, block_comment, &
         included_file
    character(len=len(statement)) :: after_include
    character(len=len_max_line) :: statement_beginning
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(init_proc)) call init_proc

    run = .false.
    end_statement = .false.
    return_statement = .false.
    end_of_file = .false.
    incomplete_statement = .false.
    other_statement = .false.
    block_comment = .false.

    unit = file_list % unit
    file_name = file_list % file_name
    line_number = file_list % line_number
    included_file = file_list % included_file
    
    do 
       if (other_statement) then !# After a `;`. Read another statement \
!#                                  on the same line.
          statement = ""
          len_statement = 0
          quote = 0
          line = adjustl(line(pos:))
          pos = 1
          other_statement = .false.
       else
          if (.not.incomplete_statement) then !# Read a new statement.
             statement = ""
             len_statement = 0
             quote = 0
          endif
          pos = 1
          
          call read_line(line, end_of_file, unit)
          file_list % line_number = line_number

          if (end_of_file) then
             if (incomplete_statement) call error_message( &
                  "previous statement is not complete.")
             if (included_file) then !# Return to enclosing file 
!#                                      and go on reading.
                call close_file(unit)
                file_list => file_list % next
                unit = file_list % unit
                file_name = file_list % file_name
                line_number = file_list % line_number
                included_file = file_list % included_file
!# ???                if (.not.associated(file_list % next)) included_file = .false.
                end_of_file = .false.
                cycle
             else !# Nothing more to read; return to main program.
                call end_proc(run) 
                return
             endif
          endif
       endif

       processed_line = ""
       len_line = 0
       quote0 = quote !# Value of variable "quote" at the beginning \
!#                       of the processed line.
       call process_line1(line, processed_line, &
            len_line, pos, quote, other_statement, block_comment)
       if (processed_line == "") cycle !# Empty line.
       call process_line2(processed_line, len_line, &
            quote0, quote, incomplete_statement)

       statement = statement(:len_statement) // processed_line(:len_line)
       len_statement = len_statement+len_line   

       if (.not.incomplete_statement .and. statement /= "") then          
          pos2 = scan(statement, " '""")
          statement_beginning = statement(:pos2-1)
          if (same_case_equal(statement_beginning, "include")) then
             after_include = adjustl(statement(pos2:))
             call include_file(file_name, after_include, &
                  read_proc, end_proc, run, end_of_file, end_statement, &
                  return_statement)
          else
             call analyze_statement(statement, &
                  read_proc, end_statement, return_statement)
          endif
          if (end_statement .or. return_statement) then
             call end_proc(run)
             return
          endif
       endif
    enddo
    
  end subroutine parse_file

!#======================================================================
  
  subroutine read_line(line, end_of_file, unit)

    use mod_strings, only : untabify
    use mod_analyze_statement, only : line_number, error_message
    use mod_convert_type, only : to_string

    implicit none
    character(len=*), intent(out) :: line
    logical, intent(out) :: end_of_file
    integer, intent(in) :: unit
!#......................................................................
    integer :: ios
    integer :: len_max_line
    character(len=2*len(line)) :: extended_line
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    len_max_line = len(line)

    read(unit, "(a)", iostat = ios) extended_line           

    line_number = line_number+1
    
    if (ios > 0) then
       call error_message("this line could not be read.")
    else if (ios < 0) then !# End of file reached.
       end_of_file = .true. !# Nothing more to read.
    else 
!# Replace horizontal tabulations by spaces {
       extended_line = untabify(extended_line)
!# }.
       
       if (extended_line(len_max_line+1:) /= "") then !# Line too long. \
!# The end of the line could not be read.
          call error_message("a line should not be longer than " // &
               to_string(len_max_line) // " characters.")
       else
          line = adjustl(extended_line(:len_max_line))
       endif
    endif

  end subroutine read_line

!#======================================================================

  recursive subroutine process_line1(line, &
       processed_line, len_line, pos, quote, other_statement, block_comment)
   
    use mod_strings, only : find_closing_quote
    
    implicit none
    character(len=*), intent(in) :: line
    character(len=*), intent(inout) :: processed_line
    integer, intent(inout) :: len_line, pos, quote
    logical, intent(out) :: other_statement
    logical, intent(inout) :: block_comment
!#......................................................................
    character(len=2) :: special_token
    character :: quote_character
    logical :: quote_found
    integer :: from_pos, shift
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    from_pos = pos
    if (block_comment) then !# Within a block-comment.
       shift = index(line(pos:), "*/")
       if (shift == 0) then
          other_statement = .false.
          return
       else
          pos = pos+shift+1
          block_comment = .false.
          call process_line1(line, processed_line, &
               len_line, pos, quote, other_statement, block_comment)
       endif
    else !# Not within a block-comment.
       if (quote == 0) then !# Not within a string.
          if (pos > len_trim(line)) then
             other_statement = .false.
             return
          endif
          
          call find_first_special_token(line, pos, special_token)

          if (special_token == "/*") then !# Block comment starting.
             
             pos = pos-1
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             pos = pos+3
             block_comment = .true.
             other_statement = .false.
             call process_line1(line, processed_line, &
                  len_line, pos, quote, other_statement, block_comment)

          else if (special_token == "!") then !# Inline comment.
             
             pos = pos-1
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             other_statement = .false.             
             return
             
          else if (special_token == ";") then
             
             if (line(pos:) /= ";") then
                other_statement = .true. !# Statement after the `;`.
             else
                other_statement = .false.
             endif
             pos = pos-1
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             pos = pos+2
             return
             
          else if (special_token == "'") then !# String beginning with `'`.
             
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             pos = pos+1
             quote = 1
             call process_line1(line, processed_line, &
                  len_line, pos, quote, other_statement, block_comment)

          else if (special_token == '"') then !# String beginning with `"`.
             
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             pos = pos+1
             quote = 2
             call process_line1(line, processed_line, &
                  len_line, pos, quote, other_statement, block_comment)

          else !# No special_token.
             
             other_statement = .false.
             pos = len_trim(line)
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             return
          endif
          
       else !# Within a string.
          
          if (quote == 1) then
             quote_character = "'"
          else !# quote = 2.
             quote_character = '"'
          endif
          call find_closing_quote(line, pos, quote_character, quote_found)
          if (quote_found) then
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             pos = pos+1
             quote = 0
             call process_line1(line, processed_line, &
                  len_line, pos, quote, other_statement, block_comment)
          else
             pos = len_trim(line)
             processed_line = processed_line(:len_line) // line(from_pos:pos)
             len_line = len_line+pos-from_pos+1
             other_statement = .false.
             return
          endif
       endif
    endif

  end subroutine process_line1

!#======================================================================

  subroutine process_line2(processed_line, len_line, &
       quote0, quote, incomplete_statement)

    use mod_analyze_statement, only : error_message
    
    implicit none
    character(len=*), intent(inout) :: processed_line
    integer, intent(out) :: len_line
    integer, intent(in) :: quote0, quote
    logical, intent(inout) :: incomplete_statement
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
!# `&` at the beginning of the line?

    processed_line = adjustl(processed_line)       
    if (processed_line(1:1) == "&") then
       processed_line = processed_line(2:)
       if (processed_line == "") call error_message( &
            "`&` should not be the only nonblank character on a line, nor be &
            &the only nonblank character before a comment.")
       if (.not.incomplete_statement) call error_message( &
            "this line begins with a `&`, but previous line did not end &
            &with `&`.")
    else if (quote0 /= 0) then
       call error_message( &
            "current line should begin with `&` since a string has been split &
            &at the end of previous line.")
    else if (incomplete_statement) then !# To detect split tokens.
       processed_line = " " // processed_line
    endif

!# `&` at the end of the line?
    
    len_line = len_trim(processed_line)
    if (processed_line(len_line:len_line) == "&") then
       incomplete_statement = .true.
       len_line = len_line-1          
    else
       if (quote /= 0) call error_message( &
            "string not closed; close it or continue the line with `&`.")
       incomplete_statement = .false.
    endif
    
  end subroutine process_line2

!#======================================================================

  subroutine find_first_special_token(line, pos, special_token)

    implicit none
    character(len=*), intent(in) :: line
    integer, intent(inout) :: pos
    character(len=2), intent(out) :: special_token
!#......................................................................
    integer :: shift, shift2
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    shift = scan(line(pos:), "!;'""")
    shift2 = index(line(pos:), "/*")

    if (shift == 0 .and. shift2 == 0) then !# No special token.
       special_token = ""
    else if (shift == 0 .or. (shift2 > 0 .and. shift2 < shift)) then !# Special \
!# token: `/*`.
       pos = pos+shift2-1
       special_token = "/*"
    else !# Other special token.
       pos = pos+shift-1
       special_token = line(pos:pos)
    endif

  end subroutine find_first_special_token
  
!#======================================================================

  subroutine include_file(enclosing_file_name, statement, &
       read_proc, end_proc, run, end_of_file, end_statement, return_statement)

    use mod_file_access
    use mod_analyze_statement, only : file_name, error_message
    
    implicit none
    external :: read_proc, end_proc
    interface
       subroutine read_proc(key, rhs, indices_string, unknown_statement, &
            statement_type)
         use mod_strings, only : same_case_equal
         implicit none
         character(len=*), intent(in) :: key, rhs, statement_type
         character(len=*), intent(inout) :: indices_string
         logical, intent(out) :: unknown_statement
       end subroutine read_proc

       subroutine end_proc(run)
         use mod_strings, only : same_case_equal
         implicit none
         logical, intent(out) :: run
       end subroutine end_proc
    end interface
    character(len=*), intent(in) :: enclosing_file_name, statement
    logical, intent(out) :: run, end_of_file, end_statement, return_statement
!#......................................................................
    character(len=len(statement)) :: included_file_name
    character(len=len(enclosing_file_name)) :: dir_name
    integer :: unit
    logical :: opened
    type(struct_file_list), pointer :: tmp_file_list
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    if (scan(statement(1:1), "'""") == 0) then
       file_name = enclosing_file_name
       call error_message( &
            "the name of an included file should be given between quotes &
            &or apostrophes.")
    endif
    read(statement,*) included_file_name
    dir_name = enclosing_file_name(:index(enclosing_file_name, "/", &
         back=.true.))
    included_file_name = trim(dir_name) // trim(included_file_name)

    inquire(file = included_file_name, opened = opened)
    if (opened) then
       file_name = enclosing_file_name
       call error_message( &
            "a file cannot include itself, directly or indirectly.")
    endif

    call open_file(unit, included_file_name)
    allocate(tmp_file_list)
    tmp_file_list % unit = unit
    tmp_file_list % file_name = included_file_name
    tmp_file_list % line_number = 0
    tmp_file_list % included_file = .true.
    tmp_file_list % next => file_list !# `next` is the enclosing file.
    file_list => tmp_file_list
    call parse_file(file_list = file_list, read_proc = read_proc, &
         end_proc = end_proc, &
         run = run, end_of_file = end_of_file, end_statement = end_statement, &
         return_statement = return_statement)
    
  end subroutine include_file

end module mod_parse_file
