module Type_Checker_m

  ! Check that specs in ALDgen input are existing specs.
  ! Check that field names are correct.
  ! Check that types of values are correct.
  ! Decorate tree nodes with declarations of labels.

  use Declaration_Table, only: Declare, Decls, Dump_A_Decl, Get_Decl
  use Declaration_Types ! Everything: Label, Spec, Field, S_*, F_*
  use Error_Handler, only: Error_Intro, Simple, Warning
  use Output_m, only: Output
  use Parser_Tables, only: N_Asterisk, N_Dot, N_Label, N_Minus, N_Plus, &
    & N_Spec, N_Tilde, N_Coord, N_Identifier, N_Number, &
    & N_String
  use String_Table, only: Display_String, Get_String, String_Length
  use Toggles, only: Con, Levels, Toggle
  use Trace, only: Trace_Begin, Trace_End
  use Tree, only: Decorate, Node_Id, NSons, Source_Ref, Subtree, &
    & Sub_Rosa

  implicit NONE
  private
  public :: Type_Checker

  type :: Fields_t
    integer, allocatable :: Names(:)
  end type Fields_t

  type(fields_t) :: Fields(First_Value:Last_Spec )

!---------------------------- RCS Module Info ------------------------------
  character (len=*), private, parameter :: ModuleName= &
       "$RCSfile: parser.f90,v $"
  private :: not_used_here 
!---------------------------------------------------------------------------

contains

  subroutine Type_Checker ( Root, Modular, Error, Warn )
    integer, intent(in) :: Root    ! of the abstract syntax tree
    integer, intent(in) :: Modular ! 1 or 2, Logic block format
      ! Row 9,  modular I:  Frame [01-99], Module [AB], EC level
      !         modular II: Frame [01-99], Gate [A-D], EC level
      ! Row 10  modular I:  Gate [1-8], Column [A-F], Row [01-26]
      !         modular II: Chassis [1-4], Row [A-K], Column [01-28]
    logical, intent(inout) :: Error  ! "An error occurred"
    logical, intent(inout) :: Warn   ! "A warning occurred"
    
    type(decls) :: Decl_L, Decl_S
    integer :: I      ! Loop inductor
    integer :: Son    ! Son of Root
    integer :: Text   ! String index of label text

    if ( toggle(con) ) call trace_begin ( 'Type_Checker', text=' for ', node=root )

    call init_symbols ( modular )

    ! Declare all the labels first, so that forward references work.
    do i = 1, nsons(root)
      son = subtree(i,root)
      if ( node_id(son) == n_label ) then
        text = sub_rosa(subtree(1,son))
        decl_l = get_decl(text,label)
        if ( decl_l%type == label ) then
          call error_intro ( simple, source_ref(subtree(1,son)) )
          call display_string ( text, before='Label ' )
          call output ( ' is a duplicate label.', advance='yes' )
          error = .true.
        else
          decl_s = get_decl ( sub_rosa(subtree(1,subtree(2,son))), spec )
          if ( decl_s%type == spec ) then
            call declare ( text, type=label, tree=subtree(2,son), &
                         & value=decl_s%value )
          end if
        end if
      end if
    end do

    error = .false.
    do i = 1, nsons(root)
      son = subtree(i,root)
      select case ( node_id(son) )
      case ( n_label ) ! .............................     Label     .....
        call check_spec ( subtree(2,son), subtree(1,son), modular, error)
      case ( n_spec ) ! ...............................     Spec     .....
        call check_spec ( son, 0, modular, error )
      case default
        ! How can we get here
      end select
    end do

    if ( toggle(con) ) call trace_end ( 'Type_Checker', text=' for ', node=root )

  end subroutine Type_Checker

! =====     Private procedures     =====================================

  subroutine Check_Spec ( Root, The_Label, Modular, Error )
    integer, intent(in) :: Root      ! of the abstract syntax tree N_Spec node
    integer, intent(in) :: The_Label ! Tree index of label, used only for Block
    integer, intent(in) :: Modular ! 1 or 2, Logic block format
      ! Row 9,  modular I:  Frame [01-99], Module [AB], EC level
      !         modular II: Frame [01-99], Gate [A-D], EC level
      ! Row 10  modular I:  Gate [1-8], Column [A-F], Row [01-26]
      !         modular II: Chassis [1-4], Row [A-K], Column [01-28]
    logical, intent(inout) :: Error  ! "An error occurred"
    type(decls) :: Decl_F, Decl_S
    integer :: Field_Ix ! Field node <f_... value value....>
    integer :: Got(last_spec+1:last_value) ! indexed by F_...
    integer :: GGSon    ! son of GSon
    integer :: GSon     ! grandson of root
    integer :: I, J
    integer :: ID       ! Node_ID(ggson)
    integer :: Name     ! string index of spec name
    integer :: Son      ! of Root
    if ( toggle(con) ) call trace_begin ( 'Check_Spec', text=' for ', node=root )
    son = subtree(1,root) ! Spec node
    name = sub_rosa(son)  ! Spec name
    decl_s = get_decl ( name, spec )
    if ( levels(con) > 0 ) call dump_a_decl ( decl_s, 'Spec decl_s', 9 )
    if ( decl_s%type == spec ) then
      ! Check for duplicate fields. Check text lengths of identifiers, strings,
      ! and numbers.
      got = 0
      do i = 2, nsons(root)
        field_ix = subtree(i,root) ! Tree node of < field name expr expr...>
        ! Verify that the name in name=value is a field name of the spec
        gson = subtree(1,field_ix)
        decl_f = get_field_decl ( gson, error ) ! Checks that it is a field name
        if ( decl_f%type == field ) then
          got(decl_f%value) = got(decl_f%value) + 1
          if ( any ( decl_f%value == abs(fields(decl_s%value)%names) ) ) then
            call decorate ( field_ix, decl_f%value ) ! Decorate with field type
          else
            call error_intro ( simple, source_ref(gson) )
            call display_string ( sub_rosa(gson) )
            call display_string ( name, before=' is not a field of ', &
                                & advance='yes' )
            error = .true.
          end if
          if ( got(decl_f%value) > 1 ) then
            call error_intro ( simple, source_ref(gson) )
            call display_string ( sub_rosa(gson) )
            call output ( ' is a duplicate field', advance='yes' )
            error = .true.
          end if
        else ! Already checked to be a field name by Get_Field_Decl
        end if
        ! Check field widths, +/-, asterisk, dot, and tilde
        do j = 2, nsons(field_ix)
          ggson = subtree(j,field_ix)
          id = node_id(ggson)
          if ( field_dot(decl_f%value) == 1 ) then ! Dot required
            if ( id /= n_dot ) then
              call error_intro ( simple, source_ref(ggson) )
              call output ( 'Field is required to be values separated by dots', &
                          & advance='yes' )
              error = .true.
            end if
          end if
          select case ( id )
          case ( n_coord, n_identifier, n_number, n_string )
            if ( string_length(sub_rosa(ggson)) - merge(2,0,id==n_string) > &
               & field_widths(decl_f%value) ) then
              call error_intro ( simple, source_ref(ggson) )
              call display_string ( sub_rosa(ggson), before='Field value ' )
              call output ( field_widths(decl_f%value), before=' has more than ' )
              call output ( ' characters.', advance='yes' )
              error = .true.
            end if
          case ( n_asterisk, n_tilde )      ! From= or To= on Line
            if ( .not. ( decl_s%value == s_line .and. &
                       & ( decl_f%value == f_from .or. &
                         & decl_f%value == f_to ) ) ) then
              call error_intro ( simple, source_ref(ggson) )
              call output ( 'Asterisk is allowed only in From= or To= on Line spec.', &
                          & advance='yes' )
              error = .true.
            end if
          case ( n_dot ) ! ...........................     Dot     .....
            if ( field_dot(decl_f%value) == 2 ) then ! Dot prohibited
              call error_intro ( simple, source_ref(ggson) )
              call display_string ( sub_rosa(gson), before='Value of ' )
              call output ( ' field cannot be a Dot expression.', advance='yes' )
            end if
          case ( n_minus, n_plus ) ! Level= on Input or Output
            if ( .not. ( decl_f%value == f_level .and. &
               &         ( decl_s%value == s_input .or. &
                         & decl_s%value == s_output ) .or. &
                         decl_f%value == f_symbol .and. &
                         decl_s%value == s_block ) ) then
              call error_intro ( simple, source_ref(ggson) )
              call output ( '+/- is allowed only in Level= on Input or Output spec ' )
              call output ( 'or Symbol= on Block spec.', advance='yes' )
              error = .true.
            end if
          end select
        end do
      end do
      ! Check for absent required fields.
      do i = 1, size(fields(decl_s%value)%names)
        if ( fields(decl_s%value)%names(i) > 0 ) then ! Required
          if ( got(fields(decl_s%value)%names(i)) == 0 ) then ! Absent
          call error_intro ( simple, source_ref(root) )
          call output ( 'Required field ' )
          call output ( trim(value_names(fields(decl_s%value)%names(i))) )
          call output ( ' is absent', advance='yes' )
          error = .true.
          end if
        end if
      end do
      call decorate ( root, decl_s%value ) ! Decorate Spec node with S_...
      select case ( decl_s%value ) ! The spec name
      case ( s_block )  ; call check_block ( root, the_label, modular, error )
      case ( s_comment) ; call check_comment ( root, error )
      case ( s_dot )    ; call check_dot ( root, error )
      case ( s_ec )     ; call check_ec ( root, error )
      case ( s_edge )   ; call check_edge ( root, error )
      case ( s_input, s_output )
        call check_input_output ( root, the_label, decl_s%value, error )
      case ( s_line )   ; call check_line ( root, error )
      case ( s_multi )  ; call check_multi ( root, error )
      case ( s_page )   ; call check_page ( root, error )
      case default ! Not a spec name
        call error_intro ( simple, source_ref(son) )
        call display_string ( name )
        call output ( ' is not a specification name.', advance='yes' )
        error = .true.
      end select
    else
      call error_intro ( simple, source_ref(son) )
      call display_string ( name )
      call output ( ' is not a Specification name.', advance='yes' )
      error = .true.
    end if
    if ( toggle(con) ) call trace_end ( 'Check_Spec', text=' for ', node=root )

  end subroutine Check_Spec

  ! ===== Check individual specifications     =====     Private     ==

  subroutine Check_Block ( Root, The_Label, Modular, Error )
    integer, intent(in) :: Root      ! of the abstract syntax tree
    integer, intent(in) :: The_Label ! Tree index of label
    integer, intent(in) :: Modular ! 1 or 2, Logic block format
      ! Row 9,  modular I:  Frame [01-99], Module [AB], EC level
      !         modular II: Frame [01-99], Gate [A-D], EC level
      ! Row 10  modular I:  Gate [1-8], Column [A-F], Row [01-26]
      !         modular II: Chassis [1-4], Row [A-K], Column [01-28]
    logical, intent(inout) :: Error  ! "An error occurred"
    type(decls) :: Decl_f
    character(2) :: Coord
    integer :: Field_Ix  ! Subtree(1,son)
    integer :: GSon      ! Son of son
    integer :: GGSon     ! Son of gson
    integer :: I, J, K
    integer :: Num       ! Numeric value of a field
    integer :: Son       ! of root
    character(4) :: Text ! of a field value
    integer :: Value     ! Sub_rosa of field value
    logical :: Wrong
    if ( toggle(con) ) call trace_begin ( 'Check_Block', text=' for ', node=root )
    ! Check that the label is a valid logic block coordinate
    if ( the_label == 0 ) then
      call error_intro ( simple, source_ref(root) )
      call output ( 'Label is required to be a logic block coordinate.', advance='yes' )
      error = .true.
    else
      call check_coord ( the_label, '2', error, coord )
    end if
    do i = 2, nsons(root)
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      ! Improper fields already diagnosed
      if ( decl_f%type /= field ) cycle
      call check_array ( son, field_ix, wrong )
      error = error .or. wrong
      do j = 2, nsons(son) ! Check all the field values anyway
        gson = subtree(j,son)
        if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
          ! Already announced as an error
          gson = subtree(1,gson)
        end if
        if ( any ( node_id(gson) == [ n_string, n_identifier, n_coord ] ) ) then
          value = sub_rosa(gson)
          call get_str ( value, text )
        end if
        ! Field names have been verified
        select case ( decl_f%value )
        case ( f_block ) ! .........................     Block     .....
          call get_numeric_field ( gson, field_ix, num, wrong, [1,99] )
        case ( f_cap ) ! .............................     Cap     .....
          if ( text(1:2) == '--' ) cycle
          call check_alpha ( gson, field_ix, text(1:2), wrong, &
            & set='ABCDEFGHJKLMNPQRSTUVWXYZ' ) ! I and O excluded
        case ( f_card ) ! ...........................     Card     .....
          call check_alpha ( gson, field_ix, text, wrong, 'A', 'Z' )
        case ( f_chassis ) ! .....................     Chassis     .....
          call get_numeric_field ( gson, field_ix, num, wrong, [1,4] )
        case ( f_column ) ! .......................     Column     .....
          if ( modular == 1 ) then
            call check_alpha ( gson, field_ix, text(1:1), wrong, 'A', 'F' )
          else
            call get_numeric_field ( gson, field_ix, num, wrong, [1,28] )
          end if
        case ( f_ec ) ! ...............................     EC     .....
          call check_alpha ( gson, field_ix, text(1:1), wrong, 'A', 'Z' )
        case ( f_frame )  ! ........................     Frame     .....
          call get_numeric_field ( gson, field_ix, num, wrong, [1,99] )
        case ( f_func ) ! ...........................     Func     .....
          if ( node_id(gson) == n_string ) text(1:2) = text(3:4)
          if ( text(1:2) == '..' ) cycle
          call check_alpha ( gson, field_ix, text(1:2), wrong , 'A', 'Z')
        case ( f_gate ) ! ...........................     Gate     .....
          if ( modular == 1 ) then
            call get_numeric_field ( gson, field_ix, num, wrong, [1,8] )
          else
            call check_alpha ( gson, field_ix, text(1:1), wrong, 'A', 'D' )
          end if
        case ( f_mode ) ! ...........................     Mode     .....
          if ( node_id(gson) == n_dot ) then
            if ( nsons(gson) > 2 ) then
              call error_intro ( simple, source_ref(gson) )
              call output ( 'Mode field contains more than two values.', advance='yes' )
              error = .true.
            end if
            do k = 1, nsons(gson)
              ggson = subtree(k,gson)
              value = sub_rosa(ggson)
              if ( string_length(value) > 2 ) then
                call error_intro ( simple, source_ref(gson) )
                call output ( 'Mode value contains more than two characters.', advance='yes' )
                error = .true.
              end if
              call get_str ( value, text )
              call check_alpha ( ggson, field_ix, text(1:2), wrong, &
                               & set=' NPRSTUMWXYZV' )
            end do
          else
            value = sub_rosa(gson)
            if ( string_length(value) > 2 ) then
              call error_intro ( simple, source_ref(gson) )
              call output ( 'Mode value contains more than two characters.', advance='yes' )
              error = .true.
            end if
            call get_str ( value, text )
            call check_alpha ( gson, field_ix, text(1:2), wrong, &
                             & set=' NPRSTUMWXYZV' )
          end if
        case ( f_module ) ! .......................     Module     .....
          call check_alpha ( gson, field_ix, text(1:1), wrong, 'A', 'B' )
        case ( f_row ) ! .............................     Row     .....
          if ( modular == 1 ) then
            call get_numeric_field ( gson, field_ix, num, wrong, [1,26] )
          else
            call check_alpha ( gson, field_ix, text(1:1), wrong, 'A', 'K' )
          end if
        case ( f_show ) ! ...........................     Show     .....
          if ( node_id(gson) == n_dot ) then
            ggson = subtree(1,gson)
            value = sub_rosa(ggson)
            call get_str ( value, text )
            call check_alpha ( ggson, field_ix, text(1:1), wrong, &
                             & set='ABCDEFGHJKLMNPR' )
            error = error .or. wrong
            call check_alpha ( ggson, field_ix, text(2:2), wrong, &
                             & set=' ABCDEFGHJKLMNPR' )
            error = error .or. wrong
            call get_numeric_field ( subtree(2,gson), field_ix, num, wrong, &
                                   & [1,16] )
            error = error .or. wrong
          else ! Already diagnosed as an error
          end if
        case ( f_symbol ) ! .......................     Symbol     .....
          call check_alpha ( gson, field_ix, text, wrong, 'A', 'Z' )
        case ( f_title ) ! .........................     Title     .....
          if ( string_length(value) > 12 ) then
            call error_intro ( simple, source_ref(gson) )
            call output ( 'Title field contains more than ten characters.', advance='yes' )
            error = .true.
          end if
        end select
        error = error .or. wrong
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Block', text=' for ', node=root )
  end subroutine Check_Block

  subroutine Check_Comment ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    integer :: GSon     ! Son of son
    integer :: I, J, K
    integer  :: Son     ! of root
    if ( toggle(con) ) call trace_begin ( 'Check_Comment', text=' for ', node=root )
    do i = 2, nsons(root) ! Should be only one son, but check them all
      son = subtree(i,root) ! Root of name=value field
      do j = 2, nsons(son) ! check all fields, even though duplicates are rejected
        gson = subtree(j,son)
        if ( node_id(gson) == n_dot ) then
          do k = 1, nsons(gson)
            call check_text ( subtree(k,gson) )
          end do ! k
        else
          call check_text ( gson )
        end if
      end do ! j
    end do ! i
    if ( toggle(con) ) call trace_end ( 'Check_Comment', text=' for ', node=root )
  contains

    subroutine Check_Text ( Node )
      integer, intent(in) :: Node
      if ( node_id(node) /= n_string ) then
        call error_intro ( simple, source_ref(node) )
        call output ( 'Text field of comment must be a string.', advance='yes' )
        error = .true.
      else if ( string_length(sub_rosa(node)) > 41 ) then
        call error_intro ( simple, source_ref(node) )
        call output ( 'Text field of comment cannot exceed 39 characters.', advance='yes' )
        error = .true.
      end if
    end subroutine Check_Text

  end subroutine Check_Comment

  subroutine Check_Dot ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    type(decls) :: Decl_f
    character(2) :: Coord
    integer :: Field_Ix ! Tree node index
    integer :: GSon     ! Son of son
    integer :: GGSon    ! Son of gson
    integer :: HV       ! H or V field
    integer :: I, J
    integer  :: Son     ! of root
    logical :: Wrong
    if ( toggle(con) ) call trace_begin ( 'Check_Dot', text=' for ', node=root )
    do i = 2, nsons(root) ! Should be only one son, but check them all
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      ! Field names have been verified
      if ( decl_f%type /= field ) cycle
      if ( decl_f%value /= f_at ) cycle
      call check_array ( son, field_ix, wrong )
      error = error .or. wrong
      do j = 2, nsons(son) ! Check all the field values anyway
        gson = subtree(j,son)
        if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
          ! Already announced as an error
          gson = subtree(1,gson)
        end if
        wrong = node_id(gson) /= n_dot
        if ( .not. wrong ) wrong = nsons(gson) /= 3
        if ( .not. wrong ) then
          ggson = subtree(1,gson)
          call check_coord ( ggson, '1', error, coord )
          ggson = subtree(2,gson)
          call get_numeric_field ( ggson, field_ix, hv, wrong, &
            & [ merge(1,2,coord(1:1)/='2'), merge(6,7,coord(1:1)=='6') ] )
          error = error .or. wrong
          ggson = subtree(3,gson)
          call get_numeric_field ( ggson, field_ix, hv, wrong, [1,18] )
          error = error .or. wrong
        else
          call error_intro ( simple, source_ref(gson) )
          call output ( 'At field is not of the form coord.h.v', advance='yes' )
          error = .true.
        end if
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Dot', text=' for ', node=root )
  end subroutine Check_Dot

  subroutine Check_EC ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    integer :: Date(3)   ! mm-dd-yy
    integer :: Days(12) = [ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ]
    type(decls) :: Decl_f           ! of Field name
    integer :: Field_Ix  ! Subtree(1,son)
    integer :: GGSon     ! Son of gson
    integer :: GSon      ! Son of son
    integer :: I, J, K
    integer :: IOstat
    integer :: Son       ! of root
    logical :: Wrong
    character(9) :: Text ! of son
    if ( toggle(con) ) call trace_begin ( 'Check_EC', text=' for ', node=root )
    do i = 2, nsons( root )
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      if ( decl_f%type /= field ) cycle
      call check_array ( son, field_ix, wrong )
      error = error .or. wrong
      do j = 2, nsons(son)
        gson = subtree(j,son)
        if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
          ! Already announced as an error
          gson = subtree(1,gson)
        end if
        ! Field names have been verified
        select case ( decl_f%value )
        case ( f_date ) ! ...........................     Date     .....
          wrong = node_id(gson) /= n_string
          if ( .not. wrong ) then
            call get_str ( sub_rosa(gson), text )
            do k = 1, 7, 3
              read ( text(k:k+1), *, iostat=iostat ) date(k/3+1)
              wrong = wrong .or. iostat /= 0
            end do
            days(2) = merge(28,29,mod(date(3),4) /= 0)
            if ( .not. wrong ) then
              wrong = date(1) < 1 .or. date(1) > 12
              if ( .not. wrong ) wrong = date(2) < 1 .or. date(2) > days(date(1))
            end if
          end if
          if ( wrong ) then
            call error_intro ( simple, source_ref(gson) )
            call output ( 'Invalid date format', advance='yes' )
            error = .true.
          end if
        case ( f_number ) ! .......................     Number     .....
          if ( node_id(gson) == n_dot ) then
            wrong = node_id(subtree(1,gson)) /= n_number
            ggson = subtree(2,gson)
            wrong = wrong .or. node_id(ggson) /= n_identifier
            if ( .not. wrong ) wrong = string_length(sub_rosa(ggson)) > 1
            if ( .not. wrong ) then
              call get_str ( sub_rosa(ggson), text )
              wrong = wrong .or. upper_case(text(1:1)) < 'A' .or. &
                               & upper_case(text(1:1)) > 'Z'
            end if
          else
            wrong = node_id(gson) /= n_number
          end if
          if ( wrong ) then
            call error_intro ( simple, source_ref(gson) )
            call output ( 'Invalid EC number', advance='yes' )
            error = .true.
          end if
        case ( f_tag )
          wrong = node_id(gson) /= n_identifier
          if ( .not. wrong ) wrong = string_length(sub_rosa(gson)) > 1
          if ( .not. wrong ) then
            call get_str ( sub_rosa(gson), text )
            wrong = upper_case(text(1:1)) < 'A' .or. &
                  & upper_case(text(1:1)) > 'Z'
          end if
          if ( wrong ) then
            call error_intro ( simple, source_ref(gson) )
            call output ( 'Invalid EC tag', advance='yes' )
            error = .true.
          end if
        end select
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_EC', text=' for ', node=root )
  end subroutine Check_EC

  subroutine Check_Edge ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    type(decls) :: Decl_f           ! of Field name
    integer :: Field_Ix  ! Subtree(1,son)
    integer :: GSon      ! Son of son
    integer :: I, J
    integer :: Son       ! of root
    character(8) :: Text
    logical :: Wrong
    if ( toggle(con) ) call trace_begin ( 'Check_Edge', text=' for ', node=root )
    do i = 2, nsons( root )
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      if ( decl_f%type /= field ) cycle
      call check_array ( son, field_ix, wrong )
      error = error .or. wrong
      do j = 2, nsons(son)
        gson = subtree(j,son)
        if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
          ! Already announced as an error
          gson = subtree(1,gson)
        end if
        ! Field names have been verified
        if ( any(node_id(gson) == [ n_identifier, n_string ]) ) then
          call get_string ( sub_rosa(gson), text )
          call check_text_width ( field_ix, gson, text, 8, error, exact=.true. )
        else
          call error_intro ( simple, source_ref(gson) )
          call output ( 'Incorrect form for edge connector.', advance='yes' )
          error = .true.
        end if
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Edge', text=' for ', node=root )
  end subroutine Check_Edge

  subroutine Check_Input_Output ( Root, The_Label, Spec, Error )
    integer, intent(in) :: Root      ! of the abstract syntax tree
    integer, intent(in) :: The_Label ! tree node index
    integer, intent(in) :: Spec      ! S_Input or S_Output
    logical, intent(inout) :: Error  ! "An error occurred"
    type(decls) :: Decl_f ! of Field name
    integer :: Field_Ix  ! Subtree(1,son)
    integer :: GSon      ! Son of son
    integer :: GGSon     ! Son of gson
    integer :: I, J, K
    integer :: Name      ! Text of gson
    integer :: Max_Len   ! of element of Text=...
    integer :: Son       ! of root
    character(15) :: Text
    logical :: Wrong
    if ( toggle(con) ) call trace_begin ( 'Check_Input', text=' for ', node=root )
    call get_str ( sub_rosa(the_label), text )
    wrong = text(1:1) /= merge('I','O',spec==s_input) .or. &
          & verify(text(2:2),'ABCDEFGHJ') /= 0 .or. &
          & verify(text(3:3),'123456') /= 0
    if ( wrong ) then
      call error_intro ( simple, source_ref(the_label) )
      call display_string ( sub_rosa(the_label), before='Label ' )
      call output ( ' is not a valid ' )
      call output ( trim(merge('In ','Out',spec==s_input)) )
      call output ( 'put spec label.', advance='yes' )
      error = .true.
    end if
    do i = 2, nsons(root)
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      ! Improperly-named fields are already diagnosed
      if ( decl_f%type /= field ) cycle
      if ( decl_f%value == f_text ) then
        if ( nsons(son) > 3 ) then
          call error_intro ( simple, source_ref(gson) )
          call output ( 'Text field cannot have more than two values.', advance='yes' )
          error = .true.
        end if
      else
        call check_array ( son, field_ix, wrong )
        error = error .or. wrong
      end if
      do j = 2, nsons(son)
        gson = subtree(j,son) ! Element of value
        ggson = gson
        if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
          ! Already announced if an error
          ggson = subtree(1,gson)
        end if
        if ( any( node_id(ggson) == &
                & [ n_coord, n_identifier, n_number, n_string ] ) ) then
          name = sub_rosa(ggson)
          call get_str ( name, text )
        end if
        ! Field names have been verified
        select case ( decl_f%value )
        case ( f_level) ! ..........................     Level     .....
          if ( .not. any(node_id(gson) == [ n_minus, n_plus ]) ) then
            call error_intro ( simple, source_ref(ggson) )
            call output ( 'Level field must specify the signal sign.', advance='yes' )
            error = .true.
          end if
          call check_alpha ( ggson, field_ix, text(1:1), wrong, set='NPRSTUMWXYZV' )
          error = error .or. wrong
        case ( f_text ) ! ...........................     Text     .....
          if ( node_id(gson) == n_dot ) then
            if ( nsons(gson) > 3 ) then
              call error_intro ( simple, source_ref(gson) )
              call output ( 'Text field cannot have more than two values.', advance='yes' )
              error = .true.
            end if
            do k = 1, nsons(gson)
              ggson = subtree(k,gson)
              name = sub_rosa(ggson)
              call get_str ( name, text )
              call check_text_width ( field_ix, ggson, text, &
                                    & merge(12,15,k==1), error )
            end do
          else
            max_len = merge(12,15,j==2)
            call check_text_width ( field_ix, ggson, text, max_len, error )
          end if
        case ( f_logic ) ! .........................     Logic     .....
          call check_logic ( field_ix, ggson, error )
        case ( f_edge ) ! ...........................     Edge     .....
          if ( node_id(gson) == n_dot ) then
            if ( nsons(gson) > 3 ) then
              call error_intro ( simple, source_ref(gson) )
              call output ( 'Edge field cannot have more than two values.', advance='yes' )
              error = .true.
            end if
            do k = 1, nsons(gson)
              ggson = subtree(k,gson)
              name = sub_rosa(ggson)
              call get_str ( name, text )
              call check_text_width ( field_ix, ggson, text, &
                                    & merge(8,1,k==1), error, exact=.true. )
              if ( k == 2 ) then
                call check_alpha ( ggson, field_ix, text(1:1), &
                                 & wrong, set='ABCDEFGHJKLMNPQRSTUVWXYZ0123456789' )
                error = error .or. wrong
              end if 
            end do
          else
            call error_intro ( simple, source_ref(gson) )
            call output ( 'Edge field must include a tag.', advance='yes' )
            error = .true.
          end if
        end select
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Input', text=' for ', node=root )
  end subroutine Check_Input_Output

  subroutine Check_Line ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    type(decls) :: Decl_f, Decl_v  ! of Field name, value if it's a label
    logical :: Check     ! Something wrong with Route character
    integer :: Field_Ix  ! Subtree(1,son)
    integer :: GSon      ! Son of son
    integer :: GGson     ! Son of gson
    integer :: GGson_s   ! sub_rosa(ggson)
    integer :: I, J, K
    integer :: Row       ! 1-6 for To and 7-12 for From
    integer :: Son       ! of root
    integer :: State     ! of route checker, 1 = alpha, 2 = numeric
    character(2) :: Text ! of son of Dot
    logical :: Wrong
    if ( toggle(con) ) call trace_begin ( 'Check_Line', text=' for ', node=root )
    do i = 2, nsons(root)
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      ! Improperly-named fields are already diagnosed
      if ( decl_f%type /= field ) cycle
      if ( decl_f%value==f_from ) then
        call check_array ( son, field_ix, wrong )
        error = error .or. wrong
      else if ( decl_f%value /= f_to ) then
        cycle
      end if
      do j = 2, nsons(son)
        gson = subtree(j,son)
        if ( any(node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ]) ) &
          & gson = subtree(1,gson) ! +/- already announced as error
        select case ( node_id ( gson ) )
        case ( n_identifier ) ! Label of Input or Output
          call check_label ( gson )
        case ( n_dot ) ! ............................      Dot     .....
                       ! Coord.row.label.route or Label.route
          ggson = subtree(1,gson) ! Block label
          if ( node_id(ggson) == n_coord ) then ! Check B.#.P
            if ( any(nsons(gson) == [3,4]) ) then
              call check_coord ( ggson, '2', error )
              decl_v = get_decl ( sub_rosa(ggson), label )
              if ( decl_v%type == label .and. decl_v%value == s_block ) then
                call decorate ( ggson, decl_v%tree ) ! Decorate ref with def
              else
                call error_intro ( simple, source_ref(ggson) )
                call display_string ( sub_rosa(ggson) )
                call output ( ' is not the label of a Block spec.', advance='yes' )
                error = .true.
              end if
              ggson = subtree(2,gson) ! Pin number 1-8 on left, 9-16 on right
              ggson_s = sub_rosa(ggson)
              ! From should be on the output (9-16) side of a block.
              ! To is usually on the input size, but sometimes on the output side
              ! of a multi (see 4A and 4B in 36.11.11.2).
              call get_numeric_field ( ggson, field_ix, row, wrong, &
                                     & [merge(1,9,decl_f%value == f_to),16] )
              error = error .or. wrong
              ggson = subtree(3,gson) ! Pin or PinTiedown
              ggson_s = sub_rosa(ggson)
              wrong = string_length(ggson_s) > 2 .or. node_id(ggson) /= n_identifier
              if ( .not. wrong ) then
                call get_str ( ggson_s, text )
                wrong = verify(text(1:1), 'ABCDEFGHJKLMNPR') /= 0
                wrong = wrong .or. verify(text(2:2), ' ABCDEFGHJKLMNPR') /= 0
              end if
              if ( wrong ) then
                call error_intro ( simple, source_ref(ggson) )
                call display_string ( sub_rosa(ggson) )
                call output ( ' is not a valid SMS card pin label.', advance='yes' )
                error = .true.
              end if
              if ( nsons(ggson) == 4 ) call check_route ( subtree(4,ggson) )
            else
              call error_intro ( simple, source_ref(gson) )
              call output ( 'Value is not of the form Coord.Row.Pin[.Route]', advance='yes' )
              error = .true.
            end if
          else ! gson = Label.Route dot vertex
            call check_label ( ggson )
            call check_route ( subtree(2,gson) )
          end if
        case default
          call error_intro ( simple, source_ref(gson) )
          call output ( 'Value is not a label or Coord.Row.Pin', advance='yes' )
          error = .true.
        end select
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Line', text=' for ', node=root )
  contains
    subroutine Check_Label ( Node )
      integer, intent(in) :: Node ! of Dot, Input, or Output label
      decl_v = get_decl ( sub_rosa(node), label )
      if ( decl_v%type == label .and. &
         & any( decl_v%value == & ! N_Spec node
             & [ merge(s_input,s_output,decl_f%value==f_from), &
               & s_dot ] ) ) then
        call decorate ( node, decl_v%tree ) ! Decorate ref with def
      else
        call error_intro ( simple, source_ref(node) )
        call display_string ( sub_rosa(node) )
        call output ( ' is not the label of an "' )
        call output ( trim(merge('In ', 'Out', decl_f%value==f_from)) )
        call output ('put" spec.', advance='yes' )
        error = .true.
      end if
    end subroutine Check_Label
    subroutine Check_Route ( Node )
      integer, intent(in) :: Node ! Of the Route field
      if ( decl_f%value /= f_to ) then
        call error_intro ( simple, source_ref(ggson) )
        call output ( 'Route part is allowed only in To field.', advance='yes' )
        error = .true.
      else
        ggson_s = sub_rosa(node)
        wrong = .false.
        state = 0 ! Nothing seen yet
        do k = 1, string_length(ggson_s)
          call get_str ( ggson_s, text, which=k )
          select case ( state )
          case ( 0 ) ! Nothing yet
            check = verify(text(1:1), 'DLRU') /= 0
            if ( .not. check ) state = 1
            if ( verify(text(1:1), 'DLRU' ) == 0 ) state = 1
            wrong = wrong .or. check
          case ( 1 ) ! Saw a letter
            check = verify(text(1:1), '0123456789') /= 0
            if ( .not. check ) state = 2
          case ( 2 ) ! Saw a number
            check = verify(text(1:1), '0123456789') /= 0
            if ( .not. check ) cycle
            check = verify(text(1:1), 'DLRU') /= 0
            if ( check ) then
              wrong = .true.
            else
              state = 1
            end if
          end select
        end do
        if ( wrong ) then
          call error_intro ( simple, source_ref(node) )
          call display_string ( sub_rosa(node) )
          call output ( ' is not a valid route {DLRU}#....', advance='yes' )
          error = .true.
        end if
      end if
    end subroutine Check_Route
  end subroutine Check_Line

  subroutine Check_Multi ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    character :: C       ! Work-around for NAG 7.101 bug 
    type(decls) :: Decl
    integer :: GSon      ! Son of son
    integer :: I, J, K
    integer :: Son       ! Son of root
    integer :: Value     ! Sub_Rosa of gson
    if ( toggle(con) ) call trace_begin ( 'Check_Multi', text=' for ', node=root )
    do i = 2, nsons(root) ! Should be only one field, but check them all
      son = subtree(i,root)
      if ( nsons(son) < 3 ) then
        call error_intro ( simple, source_ref(son) )
        call output ( 'Multi must join at least two blocks', advance='yes' )
        error = .true.
      end if
      block
        character(2) :: Coords(2:nsons(son)), T
        ! Collect the block labels
        do j = 2, nsons(son)
          gson = subtree(j,son)
          if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
            ! Already announced as an error
            gson = subtree(1,gson)
          end if
          value = sub_rosa(gson)
          call get_str ( value, coords(j) )
          decl = get_decl ( value, label )
          if ( decl%type == label .and. decl%value == s_block ) then
            call decorate ( gson, decl%tree ) ! Decorate ref with def
          else
            call error_intro ( simple, source_ref(gson) )
            call display_string ( value, before='Field value ' )
            call output ( ' is not a block label.', advance='yes' )
            error = .true.
          end if
        end do
!          if ( any(coords(2:)(1:1) /= coords(1)(1:1)) ) then ! NAG 7.101 crash
        c = coords(2)(1:1)
        if ( any(coords(3:)(1:1) /= c) ) then
          call error_intro ( simple, source_ref(son) )
          call output ( 'Columns of joined blocks are different.', &
            & advance='yes' )
          error = .true.
        end if
        ! Sort the coordinates
        do j = 2, size(coords)-1
          coords(j) = upper_case(coords(j))
        end do
        do j = 2, size(coords)-1
          do k = j+1, size(coords)
            if ( coords(k)(2:2) < coords(j)(2:2) ) then
              t = coords(k)
              coords(k) = coords(j)
              coords(j) = t
            end if
          end do
        end do
        ! Check that rows are consecutive
        where ( coords(:)(2:2) == 'J' ) coords(:)(2:2) = 'I'
        do j = 3, ubound(coords,1)
          if ( iachar(coords(j)(2:2)) /= iachar(coords(j-1)(2:2))+1 ) then
            call error_intro ( simple, source_ref(son) )
            call output ( 'Rows of joined blocks are not consecutive.', &
              & advance='yes' )
            error = .true.
            exit
          end if
        end do
      end block
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Multi', text=' for ', node=root )
  end subroutine Check_Multi

  subroutine Check_Page ( Root, Error )
    integer, intent(in) :: Root     ! of the abstract syntax tree
    logical, intent(inout) :: Error ! "An error occurred"
    type(decls) :: Decl_f
    integer :: Field_Ix  ! Subtree(1,son)
    integer :: GSon      ! Son of son
    integer :: I, J
    integer :: Num       ! Value of numeric field
    integer :: Son       ! of root
    logical :: Wrong
    if ( toggle(con) ) call trace_begin ( 'Check_Page', text=' for ', node=root )
    do i = 2, nsons(root)
      son = subtree(i,root) ! Root of name=value field
      field_ix = subtree(1,son) ! Tree node of field name
      decl_f = get_field_decl ( field_ix, error )
      ! Improperly-named fields are already diagnosed
      if ( decl_f%type /= field ) cycle
      call check_array ( son, field_ix, wrong )
      error = error .or. wrong
      do j = 2, nsons(son)
        gson = subtree(j,son)
        if ( any( node_id(gson) == [ n_asterisk, n_minus, n_plus, n_tilde ] ) ) then
          ! Already announced as an error
          gson = subtree(1,gson)
        end if
        select case ( decl_f%value )
        case ( f_logic ) ! .........................     Logic     .....
          call check_logic ( subtree(1,son), gson, error )
        case ( f_machine, f_number ) ! ...     Machine, Number     .....
          if ( node_id(subtree(1,son)) /= n_dot ) then
            call get_numeric_field ( gson, field_ix, num, wrong, warn=.true. )
          else
            call error_intro ( warning, source_ref(gson) )
            call output ( 'Number field cannot contain a Dot expression.', advance='yes' )
            error = .true.
          end if
        case ( f_title ) ! .........................     Title     .....
          if ( node_id(gson) /= n_string ) then
            call error_intro ( warning, source_ref(gson) )
            call display_string ( sub_rosa(field_ix), before='Value of ' )
            call output ( ' field is not a string', advance='yes' )
          end if
        end select
      end do
    end do
    if ( toggle(con) ) call trace_end ( 'Check_Page', text=' for ', node=root )
  end subroutine Check_Page

  ! ===== Check properties of fields =================================

  subroutine Check_Alpha ( Value, Field, Text, Error, Bot, Top, Set )
    integer, intent(in) :: Value  ! Tree index of field value
    integer, intent(in) :: Field  ! Tree index of field name
    character(*), intent(inout) :: Text   ! of field value
    logical, intent(out) :: Error
    character, intent(in), optional :: Bot, Top ! Range of characters of Text
    character(*), intent(in), optional :: Set   ! of valid characters
    integer :: K
    error = .false.
    if ( present(bot) ) then ! Assume top is present as well
      do k = 1, len_trim(text)
        text(k:k) = upper_case(text(k:k))
        error = error .or. text(k:k) < bot .or. text(k:k) > top
      end do
    else ! Assume Set is present
      error = verify(text,set) /= 0
    end if
    if ( error ) then
      call error_intro ( simple, source_ref(value) )
      call display_string ( sub_rosa(field), before='Invalid character in ' )
      call output ( ' field.', advance='yes' )
      error = .true.
    end if
  end subroutine Check_Alpha

  subroutine Check_Array ( Son, Field_Ix, Error )
    ! Check that field's value is not an array
    integer, intent(in) :: Son       ! Root of field=value
    integer, intent(in) :: Field_Ix  ! Subtree(1,son)
    logical, intent(out) :: Error    ! nsons(son) > Upper
    error = nsons(son) > 2
    if ( error ) then
      call error_intro ( simple, source_ref(son) )
      call display_string ( sub_rosa(field_ix), before='Value of ' )
      call output ( ' field cannot be an array', advance='yes' )
    end if
  end subroutine Check_Array

  subroutine Check_Coord ( Root, Low, Error, Coord )
    ! Check that a vertex is of type N_Coord and that its value
    ! consists of an integer in 2..6 and a letter in [A-HJ]
    integer, intent(in) :: Root
    character, intent(in) :: Low
    logical, intent(inout) :: Error
    character(2), intent(out), optional :: Coord
    integer :: String
    logical :: Wrong
    character(2) :: Text
    wrong = node_id(root) /= n_coord
    text = ''
    string = sub_rosa(root)
    if ( .not. wrong ) then
      wrong = string_length(string) /= 2
      if ( .not. wrong ) then
        call get_str ( string, text )
        wrong = text(1:1) < low .or. text(1:1) > '6'
        if ( .not. wrong ) &
          & wrong = verify ( text(2:2), 'ABCDEFGHJ' ) /= 0
      end if
    end if
    if ( wrong ) then
      call error_intro ( simple, source_ref(root) )
      call display_string ( string )
      call output ( ' is not a valid logic block coordinate.', advance='yes' )
      error = .true.
    end if
    if ( present(coord) ) coord = text
  end subroutine Check_Coord

  subroutine Check_Logic ( Field, Son, Error )
    integer, intent(in) :: Field ! Tree index of field name
    integer, intent(in) :: Son   ! Root of tree that should be nn.nn.nn.n
    logical, intent(inout) :: Error
    logical :: Bad
    integer :: I
    integer :: NN  ! Field value
    logical :: Wrong
    wrong = node_id(son) /= n_dot
    if ( .not. wrong ) then
      wrong = nsons(son) /= 4
      if ( .not. wrong ) then
        do i = 1, 4
          call get_numeric_field ( subtree(i,son), field, nn, bad, &
            & [ 1, merge (9, 99, i==4 ) ], warn=.true. )
          wrong = wrong .or. bad
        end do
      end if
    end if
    if ( wrong ) then
      call error_intro ( warning, source_ref(son) )
      call output ( 'Field value is not a logic page designator.', advance='yes' )
    end if
    error = error .or. wrong
  end subroutine Check_Logic

  subroutine Check_Text_Width ( Field, Son, Text, Max_Len, Error, Exact )
    integer, intent(in) :: Field     ! Tree index of field name
    integer, intent(in) :: Son       ! Tree index of text string
    character(*), intent(in) :: Text ! of Son
    integer, intent(in) :: Max_Len   ! Maximum allowed len_trim(text)
    logical, intent(inout) :: Error
    logical, intent(in), optional :: Exact ! Check exact, not max, if present
    if ( merge ( len_trim(text) /= max_len, len_trim(text) > max_len, &
               & present(exact) ) ) then
      call error_intro ( simple, source_ref(son) )
      call display_string ( sub_rosa(field), before='Width of ' )
      if ( present(exact) ) then
        call output ( max_len, before=' field must be equal to ' )
      else
        call output ( max_len, before=' field cannot be greater than ' )
      end if
      call output ( '.', advance='yes' )
      error = .true.
    end if
  end subroutine Check_Text_Width

  type(decls) function Get_Field_Decl ( Son, Error ) result ( Decl )
    integer :: Son ! Tree index of symbol
    logical, intent(inout) :: Error
    if ( levels(con) > 1 ) call trace_begin ( 'Get_Field_Decl', text=' for ', node=son )
    decl = get_decl(sub_rosa(son),field)
    if ( levels(con) > 0 ) call dump_a_decl ( decl, 'Field decl', 9 )
    if ( decl%type /= field ) then
      call error_intro ( simple, source_ref(son) )
      call display_string ( sub_rosa(son) )
      call output ( ' is not a field name.', advance='yes' )
      error = .true.
    end if
    if ( levels(con) > 1 ) call trace_end ( 'Get_Field_Decl', text=' for ', node=son )
  end function Get_Field_Decl

  subroutine Get_Numeric_Field ( Value, Field, Number, Error, Range, Warn )
    integer, intent(in) :: Value    ! Tree node index of value
    integer, intent(in) :: Field    ! Tree node index of field name
    integer, intent(out) :: Number  ! value of the numeric field
    logical, intent(out) :: Error   ! Field is not a number, or I/O error, or
                                    ! out of range
    integer, intent(in), optional :: Range(:) ! Size assumed to be even
    logical, intent(in), optional :: Warn ! If present, regardless of value
    integer :: I
    integer :: IOStat
    integer :: Level                ! of error message
    integer :: String               ! Sub_rosa(value)

    level = merge(warning,simple,present(warn))
    if ( node_id(value) /= n_number ) then
      call error_intro ( level, source_ref(value) )
      call display_string ( sub_rosa(field) )
      call display_string ( sub_rosa(value), before=' field value = ' )
      call output ( ' is not a number', advance='yes' )
      error = level == simple
      return
    end if
    string = sub_rosa(value)
    i = string_length(string)
    block
      character(i) :: line
      call get_str ( string, line )
      read ( line, *, iostat=iostat ) number
    end block
    if ( iostat /= 0 ) then ! Shouldn't happen if string is a number
      call error_intro ( level, source_ref(value) )
      call display_string ( sub_rosa(field) )
      call output ( ' field is not a number', advance='yes' )
      error = level == simple
      return
    end if
    error = .false.
    if ( present(range) ) then
      do i = 2, size(range), 2
        if ( number >= range(i-1) .and. number <= range(i) ) return
      end do
      call error_intro ( level, source_ref(value) )
      call display_string ( sub_rosa(field), before='Value in ' )
      call output ( number, before=' field = ' )
      call output ( ' is not in ' )
      do i = 2, size(range), 2
        if ( i /= 2 ) call output ( ' or ' )
        call output ( range(i-1), before='[' )
        call output ( range(i), before=',', after=']' )
      end do
      call output ( '.', advance='yes' )
      error = level == simple
    end if
  end subroutine Get_Numeric_Field

  subroutine Get_Str ( String, Text, Which )
    ! Wrapper for Get_String, to set Strip and Cap always .true.
    integer, intent(in) :: String
    character(*), intent(inout) :: Text
    integer, intent(in), optional :: Which ! Single character in the string
    call get_string ( string, text, cap=.true., strip=.true., &
                    & start=which, end=which )
  end subroutine Get_Str

  subroutine Init_Symbols ( Modular )
    use Declaration_Types, only: Field, Spec
    integer, intent(in) :: Modular
    ! Indexed by modular:
    integer, parameter :: Mod_Sel(2) = [ F_Module, F_Chassis ]
    if ( toggle(con) ) call trace_begin ( 'Init_Symbols' )
    ! Declare the spec names
    call init_one_symbol ( 'Block',   spec,  s_block )
    call init_one_symbol ( 'Comment', spec,  s_comment )
    call init_one_symbol ( 'Dot',     spec,  s_dot )
    call init_one_symbol ( 'Ec',      spec,  s_ec )
    call init_one_symbol ( 'Edge',    spec,  s_edge )
    call init_one_symbol ( 'Input',   spec,  s_input )
    call init_one_symbol ( 'Line',    spec,  s_line )
    call init_one_symbol ( 'Multi',   spec,  s_multi )
    call init_one_symbol ( 'Output',  spec,  s_output )
    call init_one_symbol ( 'Page',    spec,  s_page )
    ! Declare the field names
    call init_one_symbol ( 'At',      field, f_at      )
    call init_one_symbol ( 'Block',   field, f_block   )
    call init_one_symbol ( 'Cap',     field, f_cap     )
    call init_one_symbol ( 'Card',    field, f_card    )
    call init_one_symbol ( 'Chassis', field, f_chassis )
    call init_one_symbol ( 'Column',  field, f_column  )
    call init_one_symbol ( 'Date',    field, f_date    )
    call init_one_symbol ( 'Ec',      field, f_ec      )
    call init_one_symbol ( 'Edge',    field, f_edge    )
    call init_one_symbol ( 'Frame',   field, f_frame   )
    call init_one_symbol ( 'From',    field, f_from    )
    call init_one_symbol ( 'Func',    field, f_func    )
    call init_one_symbol ( 'Gate',    field, f_gate    )
    call init_one_symbol ( 'Level',   field, f_level   )
    call init_one_symbol ( 'Logic',   field, f_logic   )
    call init_one_symbol ( 'Machine', field, f_machine )
    call init_one_symbol ( 'Mode',    field, f_mode    )
    call init_one_symbol ( 'Module',  field, f_module  )
    call init_one_symbol ( 'Number',  field, f_number  )
    call init_one_symbol ( 'Number',  field, f_number  )
    call init_one_symbol ( 'Row',     field, f_row     )
    call init_one_symbol ( 'Show',    field, f_show    )
    call init_one_symbol ( 'Symbol',  field, f_symbol  )
    call init_one_symbol ( 'Tag',     field, f_tag     )
    call init_one_symbol ( 'Text',    field, f_text    )
    call init_one_symbol ( 'Title',   field, f_title   )
    call init_one_symbol ( 'To',      field, f_to      )

    ! Fill the fields check array. Negative values are optional.
    fields(s_block)%names = [  f_block, -f_cap, f_card, &
      & f_column, f_ec, f_frame, f_func, f_gate, f_mode, f_row, &
      & f_symbol, f_title, mod_sel(modular), -f_show ]
    fields(s_comment)%names = [ f_text ]
    fields(s_dot)%names = [ f_at ]
    fields(s_ec)%names = [ f_date, f_number, f_tag ]
    fields(s_edge)%names = [ f_text ]
    fields(s_input)%names = [ -f_edge, f_level, f_logic, f_text ]
    fields(s_line)%names = [ f_from, f_to ]
    fields(s_multi)%names = [ f_block ]
    fields(s_output)%names = [ -f_edge, f_level, f_logic, f_text ]
    fields(s_page)%names = [ f_logic, f_machine, f_number, f_title ]

    if ( toggle(con) ) call trace_end ( 'Init_Symbols' )

  end subroutine Init_Symbols

  subroutine Init_One_Symbol ( String, What, Value )
    use Symbol_Table, only: Enter_Terminal
    ! Initialize one symbol.
    character(*), intent(in) :: String   ! Symbol text
    integer, intent(in) :: What          ! Declaration type
    integer, intent(in) :: Value         ! Value field in declarationt table
    call declare ( enter_terminal ( string, 0 ), what, 0, value )
  end subroutine Init_One_Symbol

  character(:) function Upper_Case ( C )
    allocatable :: Upper_Case
    character(*) :: C
    integer :: I
    upper_case = c
    do i = 1, len(c)
      if ( c(i:i) >= 'a' .and. c(i:i) <= 'z' ) &
        & upper_case(i:i) = achar(iachar(c(i:i)) + iachar('A') - iachar('a'))
    end do
  end function Upper_Case

!--------------------------- end bloc --------------------------------------
  logical function not_used_here()
  character (len=*), parameter :: IdParm = &
       "$Id: parser.f90,v 1.4 2022/02/10 18:57:13 vsnyder Exp $"
  character (len=len(idParm)) :: Id = idParm
    not_used_here = (id(1:1) == ModuleName(1:1))
    print *, Id ! .mod files sometimes change if PRINT is added
  end function not_used_here
!---------------------------------------------------------------------------

end module Type_Checker_m

! $Log: parser.f90,v $
