------------------------------------------------------------------------------
-- BUSH Strings Package Parser                                              --
--                                                                          --
-- Part of BUSH                                                             --
------------------------------------------------------------------------------
--                                                                          --
--              Copyright (C) 2001-2005 Ken O. Burtch & FSF                 --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca                             --
--                                                                          --
------------------------------------------------------------------------------
-- CVS: $Header: /home/cvsroot/bush/src/parser_strings.adb,v 1.3 2005/08/23 12:27:14 ken Exp $

with text_io;use text_io;
with gnat.regexp,
    gnat.regpat,
    base64,
    scanner,
    string_util,
    parser_aux,
    parser,
    bush_os;
use gnat.regexp,
    gnat.regpat,
    base64,
    scanner,
    string_util,
    parser_aux,
    parser,
    bush_os;

package body parser_strings is

defaultDelimiter : constant character := ASCII.CR;
-- default delimiter for string lookup functions

procedure ParseSingleUniStringExpression( expr_val : out unbounded_string;
  expr_type : out identifier ) is
begin
  expect( symbol_t, "(" );
  ParseExpression( expr_val, expr_type );
  if uniTypesOk( expr_type, string_t ) then
     expect( symbol_t, ")" );
  end if;
end ParseSingleUniStringExpression;

procedure ParseSingleStringExpression( expr_val : out unbounded_string;
  expr_type : out identifier ) is
begin
  expect( symbol_t, "(" );
  ParseExpression( expr_val, expr_type );
  if baseTypesOk( expr_type, string_t ) then
     expect( symbol_t, ")" );
  end if;
end ParseSingleStringExpression;

procedure ParseStringsGlob( result : out unbounded_string ) is
  -- Syntax: glob( expr, string )
  -- Source: GNAT.RegExp.Match
  expr_val  : unbounded_string;
  expr_type : identifier;
  pat_val   : unbounded_string;
  pat_type  : identifier;
  re        : regexp;
  b         : boolean;
begin
  result := null_unbounded_string;
  expect( glob_t );
  expect( symbol_t, "(" );
  ParseExpression( pat_val, pat_type );
  if uniTypesOk( pat_type, uni_string_t ) then
     expect( symbol_t, "," );
     ParseExpression( expr_val, expr_type );
     if uniTypesOk( expr_type, uni_string_t ) then
        expect( symbol_t, ")" );
        if isExecutingCommand then
           begin
	     re := compile( to_string( pat_val ), glob => true,
	        case_sensitive => true );
	     b := match( to_string( expr_val ), re );
           exception when expression_error =>
	     err( "bad globbing expression '" & to_string( pat_val ) & "'" );
	     b := false;
           when storage_error =>
	     err( "formula too complex (storage_error exception)" );
	     b := false;
           when others =>
	     err( "exception raised in gnat.regexp.match" );
	     b := false;
	   end;
	   if not error_found then
	      if b then
	         result := to_unbounded_string( "1" );
              else
	         result := to_unbounded_string( "0" );
              end if;
	   end if;
        end if;
     end if;
  end if;
end ParseStringsGlob;

procedure ParseStringsMatch( result : out unbounded_string ) is
  -- Syntax: match( file )
  -- Source: GNAT.RegPat.Match
  expr_val  : unbounded_string;
  expr_type : identifier;
  pat_val   : unbounded_string;
  pat_type  : identifier;
  b         : boolean;
begin
  result := null_unbounded_string;
  getNextToken;
  expect( symbol_t, "(" );
  ParseExpression( pat_val, pat_type );
  if uniTypesOk( pat_type, uni_string_t ) then
     expect( symbol_t, "," );
     ParseExpression( expr_val, expr_type );
     if uniTypesOk( expr_type, uni_string_t ) then
        expect( symbol_t, ")" );
        if isExecutingCommand then
	   begin
	     b := match( to_string( pat_val ), to_string( expr_val ) );
           exception when expression_error =>
	     err( "bad regular expression '" & to_string( pat_val ) & "'" );
	     b := false;
           when storage_error =>
	     err( "formula too complex (storage_error exception)" );
	     b := false;
           when program_error =>
	     err( "program_error exception raised gnat.regpat.match" );
	     b := false;
           when others =>
	     err( "exception raised in gnat.regpat.match" );
	     b := false;
	   end;
	   if not error_found then
	      if b then
	         result := to_unbounded_string( "1" );
              else
	         result := to_unbounded_string( "0" );
              end if;
	      if trace then
	         if b then
		   put_trace( "'" & to_string( pat_val ) &
		   "' pattern matches string '" &
		   to_string( expr_val ) &
		   "'" );
                 else
	           put_trace( "'" & to_string( pat_val ) &
	  	   "' pattern does not match string '" &
		   to_string( expr_val ) &
		   "'" );
                 end if;
              end if;
	   end if;
        end if;
     end if;
  end if;
end ParseStringsMatch;

procedure ParseStringsElement( result : in out unbounded_string ) is
  -- Syntax: element( s, i )
  -- Source: Ada.Strings.Unbounded.Element
  str_val : unbounded_string;
  str_type : identifier;
  index_val : unbounded_string;
  index_type : identifier;
begin
  expect( element_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( index_val, index_type );
     if intTypesOk( index_type, positive_t ) then
        expect( symbol_t, ")" );
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := to_unbounded_string( "" &
           Element( str_val, positive'value( to_string( index_val ) ) ) );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsElement;

procedure ParseStringsSlice( result : in out unbounded_string ) is
  -- Syntax: slice( s, l, h )
  -- Source: Ada.Strings.Unbounded.Slice
  str_val  : unbounded_string;
  str_type : identifier;
  low_val  : unbounded_string;
  low_type : identifier;
  hi_val   : unbounded_string;
  hi_type  : identifier;
begin
  expect( slice_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( low_val, low_type );
     if intTypesOk( low_type, positive_t ) then
        expect( symbol_t, "," );
        ParseExpression( hi_val, hi_type );
        if intTypesOk( hi_type, natural_t ) then
           expect( symbol_t, ")" );
        end if;
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := to_unbounded_string(
           Slice( str_val,
	     positive'value( to_string( low_val ) ),
	     natural'value( to_string( hi_val ) )
	   ) );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsSlice;

procedure ParseStringsIndex( result : in out unbounded_string ) is
  -- Syntax: strings.index( s, p )
  -- Source: Ada.Strings.Unbounded.Index
  use ada.strings;
  str_val : unbounded_string;
  str_type : identifier;
  pat_val : unbounded_string;
  pat_type : identifier;
  dir_val : unbounded_string;
  dir_type : identifier;
  dir    : direction := forward;
begin
  expect( index_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( pat_val, pat_type );
     if baseTypesOk( pat_type, string_t ) then
        if token = symbol_t and identifiers( token ).value = "," then
           expect( symbol_t, "," );
           ParseExpression( dir_val, dir_type );
           if baseTypesOk( dir_type, strings_direction_t ) then
              if isExecutingCommand then
                 case natural( to_numeric( dir_val ) ) is
                 when 0 => dir := forward;
                 when 1 => dir := backward;
                 when others =>
                    err( "exception raised" );
                 end case;
              end if;
           end if;
         end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := to_unbounded_string( Index( str_val, to_string( pat_val ), Going => dir )'img );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsIndex;

procedure ParseStringsIndexNonBlank( result : in out unbounded_string ) is
  -- Syntax: strings.index_non_blank( s [, d] )
  -- Source: Ada.Strings.Unbounded.Index_Non_Blank
  use ada.strings;
  str_val : unbounded_string;
  str_type : identifier;
  dir_val : unbounded_string;
  dir_type : identifier;
  dir    : direction := forward;
begin
  expect( index_non_blank_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     if token = symbol_t and identifiers( token ).value = "," then
        expect( symbol_t, "," );
        ParseExpression( dir_val, dir_type );
        if baseTypesOK( dir_type, strings_direction_t ) then
           if isExecutingCommand then
              case natural( to_numeric( dir_val ) ) is
              when 0 => dir := forward;
              when 1 => dir := backward;
              when others =>
                 err( "exception raised" );
              end case;
           end if;
        end if;
     end if;
     expect( symbol_t, ")" );
  end if;
  begin
     if isExecutingCommand then
        result := to_unbounded_string( Index_Non_Blank( str_val, dir )'img );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsIndexNonBlank;

procedure ParseStringsCount( result : in out unbounded_string ) is
  -- Syntax: strings.count( s, p )
  -- Source: Ada.Strings.Unbounded.Count
  str_val : unbounded_string;
  str_type : identifier;
  pat_val : unbounded_string;
  pat_type : identifier;
begin
  expect( count_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( pat_val, pat_type );
     if baseTypesOk( pat_type, string_t ) then
        expect( symbol_t, ")" );
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := to_unbounded_string( Ada.Strings.Unbounded.Count( str_val,
           to_string( pat_val ) )'img );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsCount;

procedure ParseStringsReplaceSlice( result : in out unbounded_string ) is
  -- Syntax: strings.replace_slice( s, l, h, b )
  -- Source: Ada.Strings.Unbounded.Replace_Slice
  str_val : unbounded_string;
  str_type : identifier;
  low_val : unbounded_string;
  low_type : identifier;
  hi_val : unbounded_string;
  hi_type : identifier;
  by_val : unbounded_string;
  by_type : identifier;
begin
  expect( replace_slice_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( low_val, low_type );
     if intTypesOk( low_type, positive_t ) then
        expect( symbol_t, "," );
        ParseExpression( hi_val, hi_type );
        if intTypesOk( hi_type, natural_t ) then
           expect( symbol_t, "," );
           ParseExpression( by_val, by_type );
           if baseTypesOk( by_type, string_t ) then
              expect( symbol_t, ")" );
           end if;
        end if;
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := Replace_Slice( str_val,
	   positive'value( to_string( low_val ) ),
	   natural'value( to_string( hi_val ) ),
	   to_string( by_val )
	);
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsReplaceSlice;

procedure ParseStringsInsert( result : in out unbounded_string ) is
  -- Syntax: strings.insert( s, b, n )
  -- Source: Ada.Strings.Unbounded.Replace_Slice
  str_val : unbounded_string;
  str_type : identifier;
  before_val : unbounded_string;
  before_type : identifier;
  new_val : unbounded_string;
  new_type : identifier;
begin
  expect( strings_insert_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( before_val, before_type );
     if intTypesOk( before_type, positive_t ) then
        expect( symbol_t, "," );
        ParseExpression( new_val, new_type );
        if baseTypesOk( new_type, string_t ) then
           expect( symbol_t, ")" );
        end if;
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := Insert( str_val,
	   positive'value( to_string( before_val ) ),
	   to_string( new_val )
	);
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsInsert;

procedure ParseStringsOverwrite( result : in out unbounded_string ) is
  -- Syntax: strings.overwrite( s, p, n )
  -- Source: Ada.Strings.Unbounded.Overwrite
  str_val  : unbounded_string;
  str_type : identifier;
  pos_val  : unbounded_string;
  pos_type : identifier;
  new_val  : unbounded_string;
  new_type : identifier;
begin
  expect( overwrite_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( pos_val, pos_type );
     if intTypesOk( pos_type, positive_t ) then
        expect( symbol_t, "," );
        ParseExpression( new_val, new_type );
        if baseTypesOk( new_type, string_t ) then
           expect( symbol_t, ")" );
        end if;
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := Overwrite( str_val,
	   positive'value( to_string( pos_val ) ),
	   to_string( new_val )
	);
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsOverwrite;

procedure ParseStringsDelete( result : in out unbounded_string ) is
  -- Syntax: strings.delete( s, l, h )
  -- Source: Ada.Strings.Unbounded.Delete
  str_val  : unbounded_string;
  str_type : identifier;
  low_val  : unbounded_string;
  low_type : identifier;
  hi_val   : unbounded_string;
  hi_type  : identifier;
begin
  expect( sdelete_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( low_val, low_type );
     if intTypesOk( low_type, positive_t ) then
        expect( symbol_t, "," );
        ParseExpression( hi_val, hi_type );
        if intTypesOk( hi_type, natural_t ) then
           expect( symbol_t, ")" );
        end if;
     end if;
  end if;
  begin
     if isExecutingCommand then
        result := Delete( str_val,
	   positive'value( to_string( low_val ) ),
	   natural'value( to_string( hi_val ) )
	);
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsDelete;

procedure ParseStringsTrim( result : in out unbounded_string ) is
  -- Syntax: strings.trim( s , e )
  -- Source: Ada.Strings.Unbounded.Trim
  use ada.strings;
  str_val : unbounded_string;
  str_type : identifier;
  trim_end_val : unbounded_string;
  trim_end_type : identifier;
  the_trim_end : trim_end := both;
begin
  expect( trim_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( trim_end_val, trim_end_type );
     if baseTypesOK( trim_end_type, strings_trim_end_t ) then
         if isExecutingCommand then
            case natural( to_numeric( trim_end_val ) ) is
            when 0 => the_trim_end := left;
            when 1 => the_trim_end := right;
            when 2 => the_trim_end := both;
            when others =>
               err( "exception raised" );
            end case;
         end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := trim( str_val, the_trim_end );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsTrim;

procedure ParseStringsLength( result : in out unbounded_string ) is
  -- Syntax: strings.trim( s )
  -- Source: Ada.Strings.Unbounded.Trim
  str_val : unbounded_string;
  str_type : identifier;
begin
  expect( length_t );
  ParseSingleUniStringExpression( str_val, str_type );
  begin
     if isExecutingCommand then
        result := to_unbounded_string( length( str_val )'img );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsLength;

procedure ParseStringsHead( result : in out unbounded_string ) is
  -- Syntax: strings.head( s, c [,p] )
  -- Source: Ada.Strings.Unbounded.Head
  str_val  : unbounded_string;
  str_type : identifier;
  cnt_val  : unbounded_string;
  cnt_type : identifier;
  pad_val  : unbounded_string;
  pad_type : identifier;
  pad_char : character := ' ';
begin
  expect( head_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( cnt_val, cnt_type );
     if uniTypesOk( cnt_type, natural_t ) then
        if token = symbol_t and identifiers( token ).value = "," then
           expect( symbol_t, "," );
           ParseExpression( pad_val, pad_type );
           if baseTypesOk( pad_type, character_t ) then
           begin
              pad_char := element( pad_val, 1 );
           exception when others =>
              err( "exception raised" );
           end;
           end if;
        end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := head( str_val, natural'value( to_string( cnt_val ) ),
            pad_char );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsHead;

procedure ParseStringsTail( result : in out unbounded_string ) is
  -- Syntax: strings.tail( s, c [, p] )
  -- Source: Ada.Strings.Unbounded.Tail
  str_val  : unbounded_string;
  str_type : identifier;
  cnt_val  : unbounded_string;
  cnt_type : identifier;
  pad_val  : unbounded_string;
  pad_type : identifier;
  pad_char : character := ' ';
begin
  expect( tail_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( cnt_val, cnt_type );
     if uniTypesOk( cnt_type, natural_t ) then
        if token = symbol_t and identifiers( token ).value = "," then
           expect( symbol_t, "," );
           ParseExpression( pad_val, pad_type );
           if baseTypesOk( pad_type, character_t ) then
           begin
              pad_char := element( pad_val, 1 );
           exception when others =>
              err( "exception raised" );
           end;
           end if;
        end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := tail( str_val, natural'value( to_string( cnt_val ) ),
          pad_char );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsTail;

procedure ParseStringsField( result : in out unbounded_string ) is
  -- Syntax: strings.field( s, c [, d] )
  -- Source: N/A
  str_val  : unbounded_string;
  str_type : identifier;
  cnt_val  : unbounded_string;
  cnt_type : identifier;
  del_val  : unbounded_string;
  del_type : identifier;
  delim    : character := defaultDelimiter;
begin
  expect( field_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( cnt_val, cnt_type );
     if intTypesOk( cnt_type, natural_t ) then
        if token = symbol_t and identifiers( token ).value = "," then
           expect( symbol_t, "," );
           ParseExpression( del_val, del_type );
           if baseTypesOk( del_type, character_t ) then
              if isExecutingCommand then
                 begin
                    delim := element( del_val, 1 );
                 exception when others =>
                    err( "exception raised" );
                 end;
              end if;
           end if;
        end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := stringField( str_val, delim, natural'value( to_string( cnt_val ) ) );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsField;

procedure ParseStringsCSVField( result : in out unbounded_string ) is
  -- Syntax: strings.csv_field( s, c [, d] )
  -- Source: N/A
  str_val  : unbounded_string;
  str_type : identifier;
  cnt_val  : unbounded_string;
  cnt_type : identifier;
  del_val  : unbounded_string;
  del_type : identifier;
  delim    : character := ',';
begin
  expect( csv_field_t );
  expect( symbol_t, "(" );
  ParseExpression( str_val, str_type );
  if uniTypesOk( str_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( cnt_val, cnt_type );
     if intTypesOk( cnt_type, natural_t ) then
        if token = symbol_t and identifiers( token ).value = "," then
           expect( symbol_t, "," );
           ParseExpression( del_val, del_type );
           if baseTypesOk( del_type, character_t ) then
              if isExecutingCommand then
                 begin
                    delim := element( del_val, 1 );
                 exception when others =>
                    err( "exception raised" );
                 end;
              end if;
           end if;
        end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := stringCSVField( str_val, delim, natural'value( to_string( cnt_val ) ) );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsCSVField;

procedure ParseStringsMkTemp( result : in out unbounded_string ) is
  -- Syntax: strings.mktemp
  -- Source: BUSH builtin
  str_val : unbounded_string;
  str_type : identifier;
  mkstemp_result : aFileDescriptor;
begin
  expect( mktemp_t );
  ParseSingleStringExpression( str_val, str_type );
  if isExecutingCommand then
     declare
       LinuxPath : string := to_string( str_val ) & "XXXXXX" & ASCII.NUL;
     begin
       result := null_unbounded_string;
       mkstemp( mkstemp_result, LinuxPath );
       if mkstemp_result < 0 then
          err( "mkstemp failed " & OSError( C_errno ) );
       else
          close( mkstemp_result ); -- not the best...
          for i in aLinuxPath'range loop
            exit when LinuxPath( i ) = ASCII.NUL;
            result := result & LinuxPath( i );
          end loop;
       end if;
     end;
  end if;
end ParseStringsMkTemp;

procedure ParseStringsVal( result : in out unbounded_string ) is
  -- Syntax: strings.val( natural );
  -- Source: Ada 'val attribute
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( val_t );
  expect( symbol_t, "(" );
  ParseExpression( expr_val, expr_type );
  if intTypesOk( expr_type, natural_t ) then
     expect( symbol_t, ")" );
  end if;
  begin
    if isExecutingCommand then
       result := to_unbounded_string( "" & character'val( natural'value( to_string( expr_val ) ) ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsVal;

procedure ParseStringsImage( result : in out unbounded_string ) is
  -- Syntax: strings.image( x );
  -- Source: Ada 'image attribute
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( image_t );
  expect( symbol_t, "(" );
  ParseExpression( expr_val, expr_type );
  if uniTypesOk( expr_type, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  begin
    if isExecutingCommand then
       result := expr_val;
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsImage;

procedure ParseStringsToString( result : in out unbounded_string ) is
  -- Syntax: strings.to_string( x );
  -- Source: Ada.Strings.Unbounded.To_String
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( to_string_t );
  expect( symbol_t, "(" );
  ParseExpression( expr_val, expr_type );
  if baseTypesOk( expr_type, unbounded_string_t ) then
     expect( symbol_t, ")" );
  end if;
  begin
    if isExecutingCommand then
       result := expr_val;
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsToString;

procedure ParseStringsToUString( result : in out unbounded_string ) is
  -- Syntax: strings.to_unbounded_string( x );
  -- Source: Ada.Strings.Unbounded.To_Unbounded_String
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( to_u_string_t );
  expect( symbol_t, "(" );
  ParseExpression( expr_val, expr_type );
  if baseTypesOk( expr_type, string_t ) then
     expect( symbol_t, ")" );
  end if;
  begin
    if isExecutingCommand then
       result := expr_val;
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsToUString;

procedure ParseStringsLookup( result : in out unbounded_string ) is
  -- Syntax: strings.lookup( s, t [, d] );
  -- Source: N/A
  src_val  : unbounded_string;
  src_type : identifier;
  tar_val  : unbounded_string;
  tar_type : identifier;
  del_val  : unbounded_string;
  del_type : identifier;
  delim    : character := defaultDelimiter;
begin
  expect( lookup_t );
  expect( symbol_t, "(" );
  ParseExpression( src_val, src_type );
  if uniTypesOk( src_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( tar_val, tar_type );
        if uniTypesOk( tar_type, string_t ) then
           if token = symbol_t and identifiers( token ).value = "," then
              expect( symbol_t, "," );
              ParseExpression( del_val, del_type );
              if baseTypesOk( del_type, character_t ) then
                 if isExecutingCommand then
                    begin
                       delim := element( del_val, 1 );
                    exception when others =>
                       err( "exception raised" );
                    end;
                 end if;
              end if;
           end if;
        end if;
  end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        result := stringLookup( src_val, tar_val, delim );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsLookup;

procedure ParseStringsReplace is
  -- Syntax: strings.replace( s, f, t, [,d] );
  -- Source: N/A
  src_ref  : reference;
  tar_val  : unbounded_string;
  tar_type : identifier;
  cnt_val  : unbounded_string;
  cnt_type : identifier;
  del_val  : unbounded_string;
  del_type : identifier;
  delim    : character := defaultDelimiter;
  tempStr  : unbounded_string;
begin
  expect( replace_t );
  expect( symbol_t, "(" );
  ParseInOutParameter( src_ref );
  if uniTypesOk( src_ref.kind, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( cnt_val, cnt_type );
     if intTypesOk( cnt_type, natural_t ) then
        expect( symbol_t, "," );
        ParseExpression( tar_val, tar_type );
        if uniTypesOk( tar_type, string_t ) then
           if token = symbol_t and identifiers( token ).value = "," then
              expect( symbol_t, "," );
              ParseExpression( del_val, del_type );
              if baseTypesOk( del_type, character_t ) then
                 if isExecutingCommand then
                    begin
                       delim := element( del_val, 1 );
                    exception when others =>
                       err( "exception raised" );
                    end;
                 end if;
              end if;
           end if;
        end if;
     end if;
   end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        getParameterValue( src_ref, tempStr );
        replaceField( tempStr,
           delim,
           natural'value( to_string( cnt_val ) ),
           to_string( tar_val ) );
        AssignParameter( src_ref, tempStr );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsReplace;

procedure ParseStringsCSVReplace is
  -- Syntax: strings.csv_replace( s, f, t, [,d] );
  -- Source: N/A
  src_ref  : reference;
  tar_val  : unbounded_string;
  tar_type : identifier;
  cnt_val  : unbounded_string;
  cnt_type : identifier;
  del_val  : unbounded_string;
  del_type : identifier;
  delim    : character := ',';
  tempStr  : unbounded_string;
begin
  expect( csv_replace_t );
  expect( symbol_t, "(" );
  ParseInOutParameter( src_ref );
  if uniTypesOk( src_ref.kind, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( cnt_val, cnt_type );
     if intTypesOk( cnt_type, natural_t ) then
        expect( symbol_t, "," );
        ParseExpression( tar_val, tar_type );
        if uniTypesOk( tar_type, string_t ) then
           if token = symbol_t and identifiers( token ).value = "," then
              expect( symbol_t, "," );
              ParseExpression( del_val, del_type );
              if baseTypesOk( del_type, character_t ) then
                 if isExecutingCommand then
                    begin
                       delim := element( del_val, 1 );
                    exception when others =>
                       err( "exception raised" );
                    end;
                 end if;
              end if;
           end if;
        end if;
     end if;
   end if;
  expect( symbol_t, ")" );
  begin
     if isExecutingCommand then
        getParameterValue( src_ref, tempStr );
        replaceCSVField( tempStr,
           delim,
           natural'value( to_string( cnt_val ) ),
           to_string( tar_val ) );
        assignParameter( src_ref, tempStr );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsCSVReplace;

procedure ParseStringsToUpper( result : in out unbounded_string; kind : out identifier ) is
  -- Syntax: strings.to_upper( s );
  -- Source: Ada.Characters.Handling.To_Upper
  src_val  : unbounded_string;
  src_type : identifier;
begin
  expect( to_upper_t );
  ParseSingleUniStringExpression( src_val, src_type );
  kind := src_type;
  if isExecutingCommand then
     result := ToUpper( src_val );
  end if;
end ParseStringsToUpper;

procedure ParseStringsToLower( result : in out unbounded_string; kind : out identifier ) is
  -- Syntax: strings.to_lower( s );
  -- Source: Ada.Characters.Handling.To_Lower
  src_val  : unbounded_string;
  src_type : identifier;
begin
  expect( to_lower_t );
  ParseSingleUniStringExpression( src_val, src_type );
  kind := src_type;
  if isExecutingCommand then
     result := ToLower( src_val );
  end if;
end ParseStringsToLower;

procedure ParseStringsToProper( result : in out unbounded_string; kind : out identifier ) is
  -- Syntax: strings.to_proper( s );
  -- Source: N/A
  src_val  : unbounded_string;
  src_type : identifier;
begin
  expect( to_proper_t );
  ParseSingleUniStringExpression( src_val, src_type );
  kind := src_type;
  if isExecutingCommand then
     result := ToProper( src_val );
  end if;
end ParseStringsToProper;

procedure ParseStringsToBasic( result : in out unbounded_string; kind : out identifier ) is
  -- Syntax: strings.to_basic( s );
  -- Source: Ada.Characters.Handling.To_Basic
  src_val  : unbounded_string;
  src_type : identifier;
begin
  expect( to_basic_t );
  ParseSingleUniStringExpression( src_val, src_type );
  kind := src_type;
  if isExecutingCommand then
     result := ToBasic( src_val );
  end if;
end ParseStringsToBasic;

procedure ParseStringsToEscaped( result : in out unbounded_string; kind : out identifier ) is
  -- Syntax: strings.to_escaped( s );
  -- Source: N/A
  src_val  : unbounded_string;
  src_type : identifier;
begin
  expect( to_escaped_t );
  ParseSingleUniStringExpression( src_val, src_type );
  kind := src_type;
  if isExecutingCommand then
     result := ToEscaped( src_val );
  end if;
end ParseStringsToEscaped;

procedure ParseStringsSplit is
  -- Syntax: strings.split( s, l, r [,d] )
  -- Source: N/A (GNAT.Case_Util sort of)
  src_val  : unbounded_string;
  src_type : identifier;
  left_ref : reference;
  right_ref: reference;
  field_val: unbounded_string;
  field_type : identifier;
  delim    : character := defaultDelimiter;
  leftStr  : unbounded_string;
  rightStr : unbounded_string;
begin
  expect( split_t );
  expect( symbol_t, "(" );
  ParseExpression( src_val, src_type );
  if uniTypesOk( src_type, string_t ) then
     expect( symbol_t, "," );
     ParseOutParameter( left_ref, string_t );
     if uniTypesOk( left_ref.kind, string_t ) then
        expect( symbol_t, "," );
        ParseOutParameter( right_ref, string_t );
        if uniTypesOk( right_ref.kind, string_t ) then
           expect( symbol_t, "," );
           ParseExpression( field_val, field_type );
           if intTypesOk( field_type, natural_t ) then
              expect( symbol_t, ")" );
           end if;
        end if;
     end if;
   end if;
  begin
     if isExecutingCommand then
        split( src_val, leftStr, rightStr,
               natural'value( to_string( field_val ) ) );
        assignParameter( left_ref, leftStr );
        assignParameter( right_ref, rightStr );
     end if;
  exception when others =>
     err( "exception raised" );
  end;
end ParseStringsSplit;

procedure ParseStringsIsControl( result : in out unbounded_string) is
  -- Syntax: strings.is_control( x );
  -- Source: Ada.Characters.Handling.Is_Control (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_control_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_control( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsControl;

procedure ParseStringsIsGraphic( result : in out unbounded_string) is
  -- Syntax: strings.is_graphic( x );
  -- Source: Ada.Characters.Handling.Is_Graphic (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_graphic_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_graphic( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsGraphic;

procedure ParseStringsIsLetter( result : in out unbounded_string) is
  -- Syntax: strings.is_letter( x );
  -- Source: Ada.Characters.Handling.Is_Letter (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_letter_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_letter( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsLetter;

procedure ParseStringsIsLower( result : in out unbounded_string) is
  -- Syntax: strings.is_lower( x );
  -- Source: Ada.Characters.Handling.Is_Lower (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_lower_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_lower( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsLower;

procedure ParseStringsIsUpper( result : in out unbounded_string) is
  -- Syntax: strings.is_upper( x );
  -- Source: Ada.Characters.Handling.Is_Upper (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_upper_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_upper( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsUpper;

procedure ParseStringsIsBasic( result : in out unbounded_string) is
  -- Syntax: strings.is_basic( x );
  -- Source: Ada.Characters.Handling.Is_Basic (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_basic_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_basic( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsBasic;

procedure ParseStringsIsDigit( result : in out unbounded_string) is
  -- Syntax: strings.is_digit( x );
  -- Source: Ada.Characters.Handling.Is_Digit (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_digit_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_digit( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsDigit;

procedure ParseStringsIsHexDigit( result : in out unbounded_string) is
  -- Syntax: strings.is_hexadecimal_digit( x );
  -- Source: Ada.Characters.Handling.Is_Hexadecimal_Digit (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_hex_digit_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_hexadecimal_digit( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsHexDigit;

procedure ParseStringsIsAlphanumeric( result : in out unbounded_string) is
  -- Syntax: strings.is_alphanumeric( x );
  -- Source: Ada.Characters.Handling.Is_Alphanumeric (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_alphanumeric_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_alphanumeric( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsAlphanumeric;

procedure ParseStringsIsSpecial( result : in out unbounded_string) is
  -- Syntax: strings.is_special( x );
  -- Source: Ada.Characters.Handling.Is_Special (except for string)
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_special_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_special( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsSpecial;

procedure ParseStringsIsSlashedDate( result : in out unbounded_string) is
  -- Syntax: strings.is_slashed_date( x );
  -- Source: N/A
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_slashed_date_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_date( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsSlashedDate;

procedure ParseStringsIsFixed( result : in out unbounded_string) is
  -- Syntax: strings.is_fixed( x );
  -- Source: N/A
  expr_val   : unbounded_string;
  expr_type  : identifier;
begin
  expect( is_fixed_t );
  ParseSingleUniStringExpression( expr_val, expr_type );
  begin
    if isExecutingCommand then
       result := to_bush_boolean( is_fixed( expr_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsFixed;

-- procedure ParseStringsToBase64( result : in out unbounded_string ) is
-- begin
--   expect( to_base64_t );
--   ParseSingleUniStringExpression( expr_val, expr_type );
--   begin
--     if isExecutingCommand then
--        Encode( to_string( expr_val ), Target, Last );
--        result := to_unbounded_string( Target );
--     end if;
--   exception when others =>
--     err( "exception raised" );
--   end;
-- end ParseStringsToBase64;

-- procedure ParseStringsFromBase64( result : in out unbounded_string ) is
-- begin
--   expect( from_base64_t );
--   ParseSingleUniStringExpression( expr_val, expr_type );
--   begin
--     if isExecutingCommand then
--        Decode( to_string( expr_val ), Target, Last );
--        result := to_unbounded_string( Target );
--     end if;
--   exception when others =>
--     err( "exception raised" );
--   end;
-- end ParseStringsFromBase64;

procedure ParseStringsIsTypoOf( result : in out unbounded_string) is
  -- Syntax: strings.is_typo_of( x, y );
  -- Source: N/A
  expr1_val   : unbounded_string;
  expr1_type  : identifier;
  expr2_val   : unbounded_string;
  expr2_type  : identifier;
begin
  expect( is_typo_of_t );
  expect( symbol_t, "(" );
  ParseExpression( expr1_val, expr1_type );
  if baseTypesOk( expr1_type, string_t ) then
     expect( symbol_t, "," );
     ParseExpression( expr2_val, expr2_type );
     if baseTypesOk( expr2_type, string_t ) then
        expect( symbol_t, ")" );
     end if;
  end if;
  begin
    if isExecutingCommand then
       result := to_bush_boolean( typoOf( expr1_val, expr2_val ) );
    end if;
  exception when others =>
    err( "exception raised" );
  end;
end ParseStringsIsTypoOf;

procedure StartupStrings is
begin
  declareIdent( strings_alignment_t, "strings.alignment",
    root_enumerated_t, typeClass );
  declareStandardConstant( strings_alignment_left_t, "alignment.left",
    strings_alignment_t, "0" );
  declareStandardConstant( strings_alignment_right_t, "alignment.right",
    strings_alignment_t, "1" );
  declareStandardConstant( strings_alignment_center_t, "alignment.center",
    strings_alignment_t, "2" );

  declareIdent( strings_truncation_t, "strings.truncation",
    root_enumerated_t, typeClass );
  declareStandardConstant( strings_truncation_left_t, "truncation.left",
    strings_truncation_t, "0" );
  declareStandardConstant( strings_truncation_right_t, "truncation.right",
    strings_truncation_t, "1" );
  declareStandardConstant( strings_truncation_error_t, "truncation.error",
    strings_truncation_t, "2" );

  declareIdent( strings_membership_t, "strings.membership",
    root_enumerated_t, typeClass );
  declareStandardConstant( strings_membership_inside_t, "membership.inside",
    strings_membership_t, "0" );
  declareStandardConstant( strings_membership_outside_t, "membership.outside",
    strings_membership_t, "1" );

  declareIdent( strings_direction_t, "strings.direction",
    root_enumerated_t, typeClass );
  declareStandardConstant( strings_direction_forward_t, "direction.forward",
    strings_direction_t, "0" );
  declareStandardConstant( strings_direction_backward_t, "direction.backward",
    strings_direction_t, "1" );

  declareIdent( strings_trim_end_t, "strings.trim_end",
    root_enumerated_t, typeClass );
  declareStandardConstant( strings_trim_end_left_t, "trim_end.left",
    strings_trim_end_t, "0" );
  declareStandardConstant( strings_trim_end_right_t, "trim_end.right",
    strings_trim_end_t, "1" );
  declareStandardConstant( strings_trim_end_both_t, "trim_end.both",
    strings_trim_end_t, "2" );

  declareFunction( glob_t, "strings.glob" );
  declareFunction( match_t, "strings.match" );
  declareFunction( element_t, "strings.element" );
  declareFunction( slice_t, "strings.slice" );
  declareFunction( index_t, "strings.index" );
  declareFunction( index_non_blank_t, "strings.index_non_blank" );
  declareFunction( count_t, "strings.count" );
  declareFunction( replace_slice_t, "strings.replace_slice" );
  declareFunction( strings_insert_t, "strings.insert" );
  declareFunction( overwrite_t, "strings.overwrite" );
  declareFunction( sdelete_t, "strings.delete" );
  declareFunction( trim_t, "strings.trim" );
  declareFunction( length_t, "strings.length" );
  declareFunction( head_t, "strings.head" );
  declareFunction( tail_t, "strings.tail" );
  declareFunction( val_t, "strings.val" );
  declareFunction( image_t, "strings.image" );
  declareFunction( field_t, "strings.field" );
  declareFunction( csv_field_t, "strings.csv_field" );
  declareFunction( lookup_t, "strings.lookup" );
  declareProcedure( replace_t, "strings.replace" );
  declareProcedure( csv_replace_t, "strings.csv_replace" );
  declareFunction( to_upper_t, "strings.to_upper" );
  declareFunction( to_lower_t, "strings.to_lower" );
  declareFunction( to_proper_t, "strings.to_proper" );
  declareFunction( to_basic_t, "strings.to_basic" );
  declareFunction( to_escaped_t, "strings.to_escaped" );
  declareFunction( is_control_t, "strings.is_control" );
  declareFunction( is_graphic_t, "strings.is_graphic" );
  declareFunction( is_letter_t, "strings.is_letter" );
  declareFunction( is_lower_t, "strings.is_lower" );
  declareFunction( is_upper_t, "strings.is_upper" );
  declareFunction( is_basic_t, "strings.is_basic" );
  declareFunction( is_digit_t, "strings.is_digit" );
  declareFunction( is_hex_digit_t, "strings.is_hexadecimal_digit" );
  declareFunction( is_alphanumeric_t, "strings.is_alphanumeric" );
  declareFunction( is_special_t, "strings.is_special" );
  declareFunction( is_slashed_date_t, "strings.is_slashed_date" );
  declareFunction( is_fixed_t, "strings.is_fixed" );
  declareFunction( split_t, "strings.split" );
  declareFunction( mktemp_t, "strings.mktemp" );
  declareFunction( to_string_t, "strings.to_string" );
  declareFunction( to_u_string_t, "strings.to_unbounded_string" );
  declareFunction( is_typo_of_t, "strings.is_typo_of" );
end StartupStrings;

procedure ShutdownStrings is
begin
  null;
end ShutdownStrings;

end parser_strings;
