gcc/ada/g-awk.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T . A W K                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2000-2011, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Exceptions;
  33 with Ada.Text_IO;
  34 with Ada.Strings.Unbounded;
  35 with Ada.Strings.Fixed;
  36 with Ada.Strings.Maps;
  37 with Ada.Unchecked_Deallocation;
  38
  39 with GNAT.Directory_Operations;
  40 with GNAT.Dynamic_Tables;
  41 with GNAT.OS_Lib;
  42
  43 package body GNAT.AWK is
  44
  45    use Ada;
  46    use Ada.Strings.Unbounded;
  47
  48    -----------------------
  49    -- Local subprograms --
  50    -----------------------
  51
  52    --  The following two subprograms provide a functional interface to the
  53    --  two special session variables, that are manipulated explicitly by
  54    --  Finalize, but must be declared after Finalize to prevent static
  55    --  elaboration warnings.
  56
  57    function Get_Def return Session_Data_Access;
  58    procedure Set_Cur;
  59
  60    ----------------
  61    -- Split mode --
  62    ----------------
  63
  64    package Split is
  65
  66       type Mode is abstract tagged null record;
  67       --  This is the main type which is declared abstract. This type must be
  68       --  derived for each split style.
  69
  70       type Mode_Access is access Mode'Class;
  71
  72       procedure Current_Line (S : Mode; Session : Session_Type)
  73         is abstract;
  74       --  Split current line of Session using split mode S
  75
  76       ------------------------
  77       -- Split on separator --
  78       ------------------------
  79
  80       type Separator (Size : Positive) is new Mode with record
  81          Separators : String (1 .. Size);
  82       end record;
  83
  84       procedure Current_Line
  85         (S       : Separator;
  86          Session : Session_Type);
  87
  88       ---------------------
  89       -- Split on column --
  90       ---------------------
  91
  92       type Column (Size : Positive) is new Mode with record
  93          Columns : Widths_Set (1 .. Size);
  94       end record;
  95
  96       procedure Current_Line (S : Column; Session : Session_Type);
  97
  98    end Split;
  99
 100    procedure Free is new Unchecked_Deallocation
 101      (Split.Mode'Class, Split.Mode_Access);
 102
 103    ----------------
 104    -- File_Table --
 105    ----------------
 106
 107    type AWK_File is access String;
 108
 109    package File_Table is
 110       new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
 111    --  List of file names associated with a Session
 112
 113    procedure Free is new Unchecked_Deallocation (String, AWK_File);
 114
 115    -----------------
 116    -- Field_Table --
 117    -----------------
 118
 119    type Field_Slice is record
 120       First : Positive;
 121       Last  : Natural;
 122    end record;
 123    --  This is a field slice (First .. Last) in session's current line
 124
 125    package Field_Table is
 126       new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
 127    --  List of fields for the current line
 128
 129    --------------
 130    -- Patterns --
 131    --------------
 132
 133    --  Define all patterns style: exact string, regular expression, boolean
 134    --  function.
 135
 136    package Patterns is
 137
 138       type Pattern is abstract tagged null record;
 139       --  This is the main type which is declared abstract. This type must be
 140       --  derived for each patterns style.
 141
 142       type Pattern_Access is access Pattern'Class;
 143
 144       function Match
 145         (P       : Pattern;
 146          Session : Session_Type) return Boolean
 147       is abstract;
 148       --  Returns True if P match for the current session and False otherwise
 149
 150       procedure Release (P : in out Pattern);
 151       --  Release memory used by the pattern structure
 152
 153       --------------------------
 154       -- Exact string pattern --
 155       --------------------------
 156
 157       type String_Pattern is new Pattern with record
 158          Str  : Unbounded_String;
 159          Rank : Count;
 160       end record;
 161
 162       function Match
 163         (P       : String_Pattern;
 164          Session : Session_Type) return Boolean;
 165
 166       --------------------------------
 167       -- Regular expression pattern --
 168       --------------------------------
 169
 170       type Pattern_Matcher_Access is access Regpat.Pattern_Matcher;
 171
 172       type Regexp_Pattern is new Pattern with record
 173          Regx : Pattern_Matcher_Access;
 174          Rank : Count;
 175       end record;
 176
 177       function Match
 178         (P       : Regexp_Pattern;
 179          Session : Session_Type) return Boolean;
 180
 181       procedure Release (P : in out Regexp_Pattern);
 182
 183       ------------------------------
 184       -- Boolean function pattern --
 185       ------------------------------
 186
 187       type Callback_Pattern is new Pattern with record
 188          Pattern : Pattern_Callback;
 189       end record;
 190
 191       function Match
 192         (P       : Callback_Pattern;
 193          Session : Session_Type) return Boolean;
 194
 195    end Patterns;
 196
 197    procedure Free is new Unchecked_Deallocation
 198      (Patterns.Pattern'Class, Patterns.Pattern_Access);
 199
 200    -------------
 201    -- Actions --
 202    -------------
 203
 204    --  Define all action style : simple call, call with matches
 205
 206    package Actions is
 207
 208       type Action is abstract tagged null record;
 209       --  This is the main type which is declared abstract. This type must be
 210       --  derived for each action style.
 211
 212       type Action_Access is access Action'Class;
 213
 214       procedure Call
 215         (A       : Action;
 216          Session : Session_Type) is abstract;
 217       --  Call action A as required
 218
 219       -------------------
 220       -- Simple action --
 221       -------------------
 222
 223       type Simple_Action is new Action with record
 224          Proc : Action_Callback;
 225       end record;
 226
 227       procedure Call
 228         (A       : Simple_Action;
 229          Session : Session_Type);
 230
 231       -------------------------
 232       -- Action with matches --
 233       -------------------------
 234
 235       type Match_Action is new Action with record
 236          Proc : Match_Action_Callback;
 237       end record;
 238
 239       procedure Call
 240         (A       : Match_Action;
 241          Session : Session_Type);
 242
 243    end Actions;
 244
 245    procedure Free is new Unchecked_Deallocation
 246      (Actions.Action'Class, Actions.Action_Access);
 247
 248    --------------------------
 249    -- Pattern/Action table --
 250    --------------------------
 251
 252    type Pattern_Action is record
 253       Pattern : Patterns.Pattern_Access;  -- If Pattern is True
 254       Action  : Actions.Action_Access;    -- Action will be called
 255    end record;
 256
 257    package Pattern_Action_Table is
 258       new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50);
 259
 260    ------------------
 261    -- Session Data --
 262    ------------------
 263
 264    type Session_Data is record
 265       Current_File : Text_IO.File_Type;
 266       Current_Line : Unbounded_String;
 267       Separators   : Split.Mode_Access;
 268       Files        : File_Table.Instance;
 269       File_Index   : Natural := 0;
 270       Fields       : Field_Table.Instance;
 271       Filters      : Pattern_Action_Table.Instance;
 272       NR           : Natural := 0;
 273       FNR          : Natural := 0;
 274       Matches      : Regpat.Match_Array (0 .. 100);
 275       --  Latest matches for the regexp pattern
 276    end record;
 277
 278    procedure Free is
 279       new Unchecked_Deallocation (Session_Data, Session_Data_Access);
 280
 281    --------------
 282    -- Finalize --
 283    --------------
 284
 285    procedure Finalize (Session : in out Session_Type) is
 286    begin
 287       --  We release the session data only if it is not the default session
 288
 289       if Session.Data /= Get_Def then
 290          --  Release separators
 291
 292          Free (Session.Data.Separators);
 293
 294          Free (Session.Data);
 295
 296          --  Since we have closed the current session, set it to point now to
 297          --  the default session.
 298
 299          Set_Cur;
 300       end if;
 301    end Finalize;
 302
 303    ----------------
 304    -- Initialize --
 305    ----------------
 306
 307    procedure Initialize (Session : in out Session_Type) is
 308    begin
 309       Session.Data := new Session_Data;
 310
 311       --  Initialize separators
 312
 313       Session.Data.Separators :=
 314         new Split.Separator'(Default_Separators'Length, Default_Separators);
 315
 316       --  Initialize all tables
 317
 318       File_Table.Init  (Session.Data.Files);
 319       Field_Table.Init (Session.Data.Fields);
 320       Pattern_Action_Table.Init (Session.Data.Filters);
 321    end Initialize;
 322
 323    -----------------------
 324    -- Session Variables --
 325    -----------------------
 326
 327    Def_Session : Session_Type;
 328    Cur_Session : Session_Type;
 329
 330    ----------------------
 331    -- Private Services --
 332    ----------------------
 333
 334    function Always_True return Boolean;
 335    --  A function that always returns True
 336
 337    function Apply_Filters
 338      (Session : Session_Type) return Boolean;
 339    --  Apply any filters for which the Pattern is True for Session. It returns
 340    --  True if a least one filters has been applied (i.e. associated action
 341    --  callback has been called).
 342
 343    procedure Open_Next_File
 344      (Session : Session_Type);
 345    pragma Inline (Open_Next_File);
 346    --  Open next file for Session closing current file if needed. It raises
 347    --  End_Error if there is no more file in the table.
 348
 349    procedure Raise_With_Info
 350      (E       : Exceptions.Exception_Id;
 351       Message : String;
 352       Session : Session_Type);
 353    pragma No_Return (Raise_With_Info);
 354    --  Raises exception E with the message prepended with the current line
 355    --  number and the filename if possible.
 356
 357    procedure Read_Line (Session : Session_Type);
 358    --  Read a line for the Session and set Current_Line
 359
 360    procedure Split_Line (Session : Session_Type);
 361    --  Split session's Current_Line according to the session separators and
 362    --  set the Fields table. This procedure can be called at any time.
 363
 364    ----------------------
 365    -- Private Packages --
 366    ----------------------
 367
 368    -------------
 369    -- Actions --
 370    -------------
 371
 372    package body Actions is
 373
 374       ----------
 375       -- Call --
 376       ----------
 377
 378       procedure Call
 379         (A       : Simple_Action;
 380          Session : Session_Type)
 381       is
 382          pragma Unreferenced (Session);
 383       begin
 384          A.Proc.all;
 385       end Call;
 386
 387       ----------
 388       -- Call --
 389       ----------
 390
 391       procedure Call
 392         (A       : Match_Action;
 393          Session : Session_Type)
 394       is
 395       begin
 396          A.Proc (Session.Data.Matches);
 397       end Call;
 398
 399    end Actions;
 400
 401    --------------
 402    -- Patterns --
 403    --------------
 404
 405    package body Patterns is
 406
 407       -----------
 408       -- Match --
 409       -----------
 410
 411       function Match
 412         (P       : String_Pattern;
 413          Session : Session_Type) return Boolean
 414       is
 415       begin
 416          return P.Str = Field (P.Rank, Session);
 417       end Match;
 418
 419       -----------
 420       -- Match --
 421       -----------
 422
 423       function Match
 424         (P       : Regexp_Pattern;
 425          Session : Session_Type) return Boolean
 426       is
 427          use type Regpat.Match_Location;
 428       begin
 429          Regpat.Match
 430            (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
 431          return Session.Data.Matches (0) /= Regpat.No_Match;
 432       end Match;
 433
 434       -----------
 435       -- Match --
 436       -----------
 437
 438       function Match
 439         (P       : Callback_Pattern;
 440          Session : Session_Type) return Boolean
 441       is
 442          pragma Unreferenced (Session);
 443       begin
 444          return P.Pattern.all;
 445       end Match;
 446
 447       -------------
 448       -- Release --
 449       -------------
 450
 451       procedure Release (P : in out Pattern) is
 452          pragma Unreferenced (P);
 453       begin
 454          null;
 455       end Release;
 456
 457       -------------
 458       -- Release --
 459       -------------
 460
 461       procedure Release (P : in out Regexp_Pattern) is
 462          procedure Free is new Unchecked_Deallocation
 463            (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
 464       begin
 465          Free (P.Regx);
 466       end Release;
 467
 468    end Patterns;
 469
 470    -----------
 471    -- Split --
 472    -----------
 473
 474    package body Split is
 475
 476       use Ada.Strings;
 477
 478       ------------------
 479       -- Current_Line --
 480       ------------------
 481
 482       procedure Current_Line (S : Separator; Session : Session_Type) is
 483          Line   : constant String := To_String (Session.Data.Current_Line);
 484          Fields : Field_Table.Instance renames Session.Data.Fields;
 485          Seps   : constant Maps.Character_Set := Maps.To_Set (S.Separators);
 486
 487          Start  : Natural;
 488          Stop   : Natural;
 489
 490       begin
 491          --  First field start here
 492
 493          Start := Line'First;
 494
 495          --  Record the first field start position which is the first character
 496          --  in the line.
 497
 498          Field_Table.Increment_Last (Fields);
 499          Fields.Table (Field_Table.Last (Fields)).First := Start;
 500
 501          loop
 502             --  Look for next separator
 503
 504             Stop := Fixed.Index
 505               (Source => Line (Start .. Line'Last),
 506                Set    => Seps);
 507
 508             exit when Stop = 0;
 509
 510             Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
 511
 512             --  If separators are set to the default (space and tab) we skip
 513             --  all spaces and tabs following current field.
 514
 515             if S.Separators = Default_Separators then
 516                Start := Fixed.Index
 517                  (Line (Stop + 1 .. Line'Last),
 518                   Maps.To_Set (Default_Separators),
 519                   Outside,
 520                   Strings.Forward);
 521
 522                if Start = 0 then
 523                   Start := Stop + 1;
 524                end if;
 525
 526             else
 527                Start := Stop + 1;
 528             end if;
 529
 530             --  Record in the field table the start of this new field
 531
 532             Field_Table.Increment_Last (Fields);
 533             Fields.Table (Field_Table.Last (Fields)).First := Start;
 534
 535          end loop;
 536
 537          Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
 538       end Current_Line;
 539
 540       ------------------
 541       -- Current_Line --
 542       ------------------
 543
 544       procedure Current_Line (S : Column; Session : Session_Type) is
 545          Line   : constant String := To_String (Session.Data.Current_Line);
 546          Fields : Field_Table.Instance renames Session.Data.Fields;
 547          Start  : Positive := Line'First;
 548
 549       begin
 550          --  Record the first field start position which is the first character
 551          --  in the line.
 552
 553          for C in 1 .. S.Columns'Length loop
 554
 555             Field_Table.Increment_Last (Fields);
 556
 557             Fields.Table (Field_Table.Last (Fields)).First := Start;
 558
 559             Start := Start + S.Columns (C);
 560
 561             Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
 562
 563          end loop;
 564
 565          --  If there is some remaining character on the line, add them in a
 566          --  new field.
 567
 568          if Start - 1 < Line'Length then
 569
 570             Field_Table.Increment_Last (Fields);
 571
 572             Fields.Table (Field_Table.Last (Fields)).First := Start;
 573
 574             Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
 575          end if;
 576       end Current_Line;
 577
 578    end Split;
 579
 580    --------------
 581    -- Add_File --
 582    --------------
 583
 584    procedure Add_File
 585      (Filename : String;
 586       Session  : Session_Type)
 587    is
 588       Files : File_Table.Instance renames Session.Data.Files;
 589
 590    begin
 591       if OS_Lib.Is_Regular_File (Filename) then
 592          File_Table.Increment_Last (Files);
 593          Files.Table (File_Table.Last (Files)) := new String'(Filename);
 594       else
 595          Raise_With_Info
 596            (File_Error'Identity,
 597             "File " & Filename & " not found.",
 598             Session);
 599       end if;
 600    end Add_File;
 601
 602    procedure Add_File
 603      (Filename : String)
 604    is
 605
 606    begin
 607       Add_File (Filename, Cur_Session);
 608    end Add_File;
 609
 610    ---------------
 611    -- Add_Files --
 612    ---------------
 613
 614    procedure Add_Files
 615      (Directory             : String;
 616       Filenames             : String;
 617       Number_Of_Files_Added : out Natural;
 618       Session               : Session_Type)
 619    is
 620       use Directory_Operations;
 621
 622       Dir      : Dir_Type;
 623       Filename : String (1 .. 200);
 624       Last     : Natural;
 625
 626    begin
 627       Number_Of_Files_Added := 0;
 628
 629       Open (Dir, Directory);
 630
 631       loop
 632          Read (Dir, Filename, Last);
 633          exit when Last = 0;
 634
 635          Add_File (Filename (1 .. Last), Session);
 636          Number_Of_Files_Added := Number_Of_Files_Added + 1;
 637       end loop;
 638
 639       Close (Dir);
 640
 641    exception
 642       when others =>
 643          Raise_With_Info
 644            (File_Error'Identity,
 645             "Error scanning directory " & Directory
 646             & " for files " & Filenames & '.',
 647             Session);
 648    end Add_Files;
 649
 650    procedure Add_Files
 651      (Directory             : String;
 652       Filenames             : String;
 653       Number_Of_Files_Added : out Natural)
 654    is
 655
 656    begin
 657       Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session);
 658    end Add_Files;
 659
 660    -----------------
 661    -- Always_True --
 662    -----------------
 663
 664    function Always_True return Boolean is
 665    begin
 666       return True;
 667    end Always_True;
 668
 669    -------------------
 670    -- Apply_Filters --
 671    -------------------
 672
 673    function Apply_Filters
 674      (Session : Session_Type) return Boolean
 675    is
 676       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
 677       Results : Boolean := False;
 678
 679    begin
 680       --  Iterate through the filters table, if pattern match call action
 681
 682       for F in 1 .. Pattern_Action_Table.Last (Filters) loop
 683          if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
 684             Results := True;
 685             Actions.Call (Filters.Table (F).Action.all, Session);
 686          end if;
 687       end loop;
 688
 689       return Results;
 690    end Apply_Filters;
 691
 692    -----------
 693    -- Close --
 694    -----------
 695
 696    procedure Close (Session : Session_Type) is
 697       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
 698       Files   : File_Table.Instance renames Session.Data.Files;
 699
 700    begin
 701       --  Close current file if needed
 702
 703       if Text_IO.Is_Open (Session.Data.Current_File) then
 704          Text_IO.Close (Session.Data.Current_File);
 705       end if;
 706
 707       --  Release Filters table
 708
 709       for F in 1 .. Pattern_Action_Table.Last (Filters) loop
 710          Patterns.Release (Filters.Table (F).Pattern.all);
 711          Free (Filters.Table (F).Pattern);
 712          Free (Filters.Table (F).Action);
 713       end loop;
 714
 715       for F in 1 .. File_Table.Last (Files) loop
 716          Free (Files.Table (F));
 717       end loop;
 718
 719       File_Table.Set_Last (Session.Data.Files, 0);
 720       Field_Table.Set_Last (Session.Data.Fields, 0);
 721       Pattern_Action_Table.Set_Last (Session.Data.Filters, 0);
 722
 723       Session.Data.NR := 0;
 724       Session.Data.FNR := 0;
 725       Session.Data.File_Index := 0;
 726       Session.Data.Current_Line := Null_Unbounded_String;
 727    end Close;
 728
 729    ---------------------
 730    -- Current_Session --
 731    ---------------------
 732
 733    function Current_Session return not null access Session_Type is
 734    begin
 735       return Cur_Session.Self;
 736    end Current_Session;
 737
 738    ---------------------
 739    -- Default_Session --
 740    ---------------------
 741
 742    function Default_Session return not null access Session_Type is
 743    begin
 744       return Def_Session.Self;
 745    end Default_Session;
 746
 747    --------------------
 748    -- Discrete_Field --
 749    --------------------
 750
 751    function Discrete_Field
 752      (Rank    : Count;
 753       Session : Session_Type) return Discrete
 754    is
 755    begin
 756       return Discrete'Value (Field (Rank, Session));
 757    end Discrete_Field;
 758
 759    function Discrete_Field_Current_Session
 760      (Rank    : Count) return Discrete is
 761       function Do_It is new Discrete_Field (Discrete);
 762    begin
 763       return Do_It (Rank, Cur_Session);
 764    end Discrete_Field_Current_Session;
 765
 766    -----------------
 767    -- End_Of_Data --
 768    -----------------
 769
 770    function End_Of_Data
 771      (Session : Session_Type) return Boolean
 772    is
 773    begin
 774       return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
 775         and then End_Of_File (Session);
 776    end End_Of_Data;
 777
 778    function End_Of_Data
 779      return Boolean
 780    is
 781    begin
 782       return End_Of_Data (Cur_Session);
 783    end End_Of_Data;
 784
 785    -----------------
 786    -- End_Of_File --
 787    -----------------
 788
 789    function End_Of_File
 790      (Session : Session_Type) return Boolean
 791    is
 792    begin
 793       return Text_IO.End_Of_File (Session.Data.Current_File);
 794    end End_Of_File;
 795
 796    function End_Of_File
 797      return Boolean
 798    is
 799    begin
 800       return End_Of_File (Cur_Session);
 801    end End_Of_File;
 802
 803    -----------
 804    -- Field --
 805    -----------
 806
 807    function Field
 808      (Rank    : Count;
 809       Session : Session_Type) return String
 810    is
 811       Fields : Field_Table.Instance renames Session.Data.Fields;
 812
 813    begin
 814       if Rank > Number_Of_Fields (Session) then
 815          Raise_With_Info
 816            (Field_Error'Identity,
 817             "Field number" & Count'Image (Rank) & " does not exist.",
 818             Session);
 819
 820       elsif Rank = 0 then
 821
 822          --  Returns the whole line, this is what $0 does under Session_Type
 823
 824          return To_String (Session.Data.Current_Line);
 825
 826       else
 827          return Slice (Session.Data.Current_Line,
 828                        Fields.Table (Positive (Rank)).First,
 829                        Fields.Table (Positive (Rank)).Last);
 830       end if;
 831    end Field;
 832
 833    function Field
 834      (Rank    : Count) return String
 835    is
 836    begin
 837       return Field (Rank, Cur_Session);
 838    end Field;
 839
 840    function Field
 841      (Rank    : Count;
 842       Session : Session_Type) return Integer
 843    is
 844    begin
 845       return Integer'Value (Field (Rank, Session));
 846
 847    exception
 848       when Constraint_Error =>
 849          Raise_With_Info
 850            (Field_Error'Identity,
 851             "Field number" & Count'Image (Rank)
 852             & " cannot be converted to an integer.",
 853             Session);
 854    end Field;
 855
 856    function Field
 857      (Rank    : Count) return Integer
 858    is
 859    begin
 860       return Field (Rank, Cur_Session);
 861    end Field;
 862
 863    function Field
 864      (Rank    : Count;
 865       Session : Session_Type) return Float
 866    is
 867    begin
 868       return Float'Value (Field (Rank, Session));
 869
 870    exception
 871       when Constraint_Error =>
 872          Raise_With_Info
 873            (Field_Error'Identity,
 874             "Field number" & Count'Image (Rank)
 875             & " cannot be converted to a float.",
 876             Session);
 877    end Field;
 878
 879    function Field
 880      (Rank    : Count) return Float
 881    is
 882    begin
 883       return Field (Rank, Cur_Session);
 884    end Field;
 885
 886    ----------
 887    -- File --
 888    ----------
 889
 890    function File
 891      (Session : Session_Type) return String
 892    is
 893       Files : File_Table.Instance renames Session.Data.Files;
 894
 895    begin
 896       if Session.Data.File_Index = 0 then
 897          return "??";
 898       else
 899          return Files.Table (Session.Data.File_Index).all;
 900       end if;
 901    end File;
 902
 903    function File
 904      return String
 905    is
 906    begin
 907       return File (Cur_Session);
 908    end File;
 909
 910    --------------------
 911    -- For_Every_Line --
 912    --------------------
 913
 914    procedure For_Every_Line
 915      (Separators : String        := Use_Current;
 916       Filename   : String        := Use_Current;
 917       Callbacks  : Callback_Mode := None;
 918       Session    : Session_Type)
 919    is
 920       Quit : Boolean;
 921
 922    begin
 923       Open (Separators, Filename, Session);
 924
 925       while not End_Of_Data (Session) loop
 926          Read_Line (Session);
 927          Split_Line (Session);
 928
 929          if Callbacks in Only .. Pass_Through then
 930             declare
 931                Discard : Boolean;
 932                pragma Unreferenced (Discard);
 933             begin
 934                Discard := Apply_Filters (Session);
 935             end;
 936          end if;
 937
 938          if Callbacks /= Only then
 939             Quit := False;
 940             Action (Quit);
 941             exit when Quit;
 942          end if;
 943       end loop;
 944
 945       Close (Session);
 946    end For_Every_Line;
 947
 948    procedure For_Every_Line_Current_Session
 949      (Separators : String        := Use_Current;
 950       Filename   : String        := Use_Current;
 951       Callbacks  : Callback_Mode := None)
 952    is
 953       procedure Do_It is new For_Every_Line (Action);
 954    begin
 955       Do_It (Separators, Filename, Callbacks, Cur_Session);
 956    end For_Every_Line_Current_Session;
 957
 958    --------------
 959    -- Get_Line --
 960    --------------
 961
 962    procedure Get_Line
 963      (Callbacks : Callback_Mode := None;
 964       Session   : Session_Type)
 965    is
 966       Filter_Active : Boolean;
 967
 968    begin
 969       if not Text_IO.Is_Open (Session.Data.Current_File) then
 970          raise File_Error;
 971       end if;
 972
 973       loop
 974          Read_Line (Session);
 975          Split_Line (Session);
 976
 977          case Callbacks is
 978
 979             when None =>
 980                exit;
 981
 982             when Only =>
 983                Filter_Active := Apply_Filters (Session);
 984                exit when not Filter_Active;
 985
 986             when Pass_Through =>
 987                Filter_Active := Apply_Filters (Session);
 988                exit;
 989
 990          end case;
 991       end loop;
 992    end Get_Line;
 993
 994    procedure Get_Line
 995      (Callbacks : Callback_Mode := None)
 996    is
 997    begin
 998       Get_Line (Callbacks, Cur_Session);
 999    end Get_Line;
1000
1001    ----------------------
1002    -- Number_Of_Fields --
1003    ----------------------
1004
1005    function Number_Of_Fields
1006      (Session : Session_Type) return Count
1007    is
1008    begin
1009       return Count (Field_Table.Last (Session.Data.Fields));
1010    end Number_Of_Fields;
1011
1012    function Number_Of_Fields
1013      return Count
1014    is
1015    begin
1016       return Number_Of_Fields (Cur_Session);
1017    end Number_Of_Fields;
1018
1019    --------------------------
1020    -- Number_Of_File_Lines --
1021    --------------------------
1022
1023    function Number_Of_File_Lines
1024      (Session : Session_Type) return Count
1025    is
1026    begin
1027       return Count (Session.Data.FNR);
1028    end Number_Of_File_Lines;
1029
1030    function Number_Of_File_Lines
1031      return Count
1032    is
1033    begin
1034       return Number_Of_File_Lines (Cur_Session);
1035    end Number_Of_File_Lines;
1036
1037    ---------------------
1038    -- Number_Of_Files --
1039    ---------------------
1040
1041    function Number_Of_Files
1042      (Session : Session_Type) return Natural
1043    is
1044       Files : File_Table.Instance renames Session.Data.Files;
1045    begin
1046       return File_Table.Last (Files);
1047    end Number_Of_Files;
1048
1049    function Number_Of_Files
1050      return Natural
1051    is
1052    begin
1053       return Number_Of_Files (Cur_Session);
1054    end Number_Of_Files;
1055
1056    ---------------------
1057    -- Number_Of_Lines --
1058    ---------------------
1059
1060    function Number_Of_Lines
1061      (Session : Session_Type) return Count
1062    is
1063    begin
1064       return Count (Session.Data.NR);
1065    end Number_Of_Lines;
1066
1067    function Number_Of_Lines
1068      return Count
1069    is
1070    begin
1071       return Number_Of_Lines (Cur_Session);
1072    end Number_Of_Lines;
1073
1074    ----------
1075    -- Open --
1076    ----------
1077
1078    procedure Open
1079      (Separators : String       := Use_Current;
1080       Filename   : String       := Use_Current;
1081       Session    : Session_Type)
1082    is
1083    begin
1084       if Text_IO.Is_Open (Session.Data.Current_File) then
1085          raise Session_Error;
1086       end if;
1087
1088       if Filename /= Use_Current then
1089          File_Table.Init (Session.Data.Files);
1090          Add_File (Filename, Session);
1091       end if;
1092
1093       if Separators /= Use_Current then
1094          Set_Field_Separators (Separators, Session);
1095       end if;
1096
1097       Open_Next_File (Session);
1098
1099    exception
1100       when End_Error =>
1101          raise File_Error;
1102    end Open;
1103
1104    procedure Open
1105      (Separators : String       := Use_Current;
1106       Filename   : String       := Use_Current)
1107    is
1108    begin
1109       Open (Separators, Filename, Cur_Session);
1110    end Open;
1111
1112    --------------------
1113    -- Open_Next_File --
1114    --------------------
1115
1116    procedure Open_Next_File
1117      (Session : Session_Type)
1118    is
1119       Files : File_Table.Instance renames Session.Data.Files;
1120
1121    begin
1122       if Text_IO.Is_Open (Session.Data.Current_File) then
1123          Text_IO.Close (Session.Data.Current_File);
1124       end if;
1125
1126       Session.Data.File_Index := Session.Data.File_Index + 1;
1127
1128       --  If there are no mores file in the table, raise End_Error
1129
1130       if Session.Data.File_Index > File_Table.Last (Files) then
1131          raise End_Error;
1132       end if;
1133
1134       Text_IO.Open
1135         (File => Session.Data.Current_File,
1136          Name => Files.Table (Session.Data.File_Index).all,
1137          Mode => Text_IO.In_File);
1138    end Open_Next_File;
1139
1140    -----------
1141    -- Parse --
1142    -----------
1143
1144    procedure Parse
1145      (Separators : String       := Use_Current;
1146       Filename   : String       := Use_Current;
1147       Session    : Session_Type)
1148    is
1149       Filter_Active : Boolean;
1150       pragma Unreferenced (Filter_Active);
1151
1152    begin
1153       Open (Separators, Filename, Session);
1154
1155       while not End_Of_Data (Session) loop
1156          Get_Line (None, Session);
1157          Filter_Active := Apply_Filters (Session);
1158       end loop;
1159
1160       Close (Session);
1161    end Parse;
1162
1163    procedure Parse
1164      (Separators : String       := Use_Current;
1165       Filename   : String       := Use_Current)
1166    is
1167    begin
1168       Parse (Separators, Filename, Cur_Session);
1169    end Parse;
1170
1171    ---------------------
1172    -- Raise_With_Info --
1173    ---------------------
1174
1175    procedure Raise_With_Info
1176      (E       : Exceptions.Exception_Id;
1177       Message : String;
1178       Session : Session_Type)
1179    is
1180       function Filename return String;
1181       --  Returns current filename and "??" if this information is not
1182       --  available.
1183
1184       function Line return String;
1185       --  Returns current line number without the leading space
1186
1187       --------------
1188       -- Filename --
1189       --------------
1190
1191       function Filename return String is
1192          File : constant String := AWK.File (Session);
1193       begin
1194          if File = "" then
1195             return "??";
1196          else
1197             return File;
1198          end if;
1199       end Filename;
1200
1201       ----------
1202       -- Line --
1203       ----------
1204
1205       function Line return String is
1206          L : constant String := Natural'Image (Session.Data.FNR);
1207       begin
1208          return L (2 .. L'Last);
1209       end Line;
1210
1211    --  Start of processing for Raise_With_Info
1212
1213    begin
1214       Exceptions.Raise_Exception
1215         (E,
1216          '[' & Filename & ':' & Line & "] " & Message);
1217       raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1218    end Raise_With_Info;
1219
1220    ---------------
1221    -- Read_Line --
1222    ---------------
1223
1224    procedure Read_Line (Session : Session_Type) is
1225
1226       function Read_Line return String;
1227       --  Read a line in the current file. This implementation is recursive
1228       --  and does not have a limitation on the line length.
1229
1230       NR  : Natural renames Session.Data.NR;
1231       FNR : Natural renames Session.Data.FNR;
1232
1233       ---------------
1234       -- Read_Line --
1235       ---------------
1236
1237       function Read_Line return String is
1238          Buffer : String (1 .. 1_024);
1239          Last   : Natural;
1240
1241       begin
1242          Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1243
1244          if Last = Buffer'Last then
1245             return Buffer & Read_Line;
1246          else
1247             return Buffer (1 .. Last);
1248          end if;
1249       end Read_Line;
1250
1251    --  Start of processing for Read_Line
1252
1253    begin
1254       if End_Of_File (Session) then
1255          Open_Next_File (Session);
1256          FNR := 0;
1257       end if;
1258
1259       Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1260
1261       NR := NR + 1;
1262       FNR := FNR + 1;
1263    end Read_Line;
1264
1265    --------------
1266    -- Register --
1267    --------------
1268
1269    procedure Register
1270      (Field   : Count;
1271       Pattern : String;
1272       Action  : Action_Callback;
1273       Session : Session_Type)
1274    is
1275       Filters   : Pattern_Action_Table.Instance renames Session.Data.Filters;
1276       U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1277
1278    begin
1279       Pattern_Action_Table.Increment_Last (Filters);
1280
1281       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1282         (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1283          Action  => new Actions.Simple_Action'(Proc => Action));
1284    end Register;
1285
1286    procedure Register
1287      (Field   : Count;
1288       Pattern : String;
1289       Action  : Action_Callback)
1290    is
1291    begin
1292       Register (Field, Pattern, Action, Cur_Session);
1293    end Register;
1294
1295    procedure Register
1296      (Field   : Count;
1297       Pattern : GNAT.Regpat.Pattern_Matcher;
1298       Action  : Action_Callback;
1299       Session : Session_Type)
1300    is
1301       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1302
1303       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1304                     new Regpat.Pattern_Matcher'(Pattern);
1305    begin
1306       Pattern_Action_Table.Increment_Last (Filters);
1307
1308       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1309         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1310          Action  => new Actions.Simple_Action'(Proc => Action));
1311    end Register;
1312
1313    procedure Register
1314      (Field   : Count;
1315       Pattern : GNAT.Regpat.Pattern_Matcher;
1316       Action  : Action_Callback)
1317    is
1318    begin
1319       Register (Field, Pattern, Action, Cur_Session);
1320    end Register;
1321
1322    procedure Register
1323      (Field   : Count;
1324       Pattern : GNAT.Regpat.Pattern_Matcher;
1325       Action  : Match_Action_Callback;
1326       Session : Session_Type)
1327    is
1328       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1329
1330       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1331                     new Regpat.Pattern_Matcher'(Pattern);
1332    begin
1333       Pattern_Action_Table.Increment_Last (Filters);
1334
1335       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1336         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1337          Action  => new Actions.Match_Action'(Proc => Action));
1338    end Register;
1339
1340    procedure Register
1341      (Field   : Count;
1342       Pattern : GNAT.Regpat.Pattern_Matcher;
1343       Action  : Match_Action_Callback)
1344    is
1345    begin
1346       Register (Field, Pattern, Action, Cur_Session);
1347    end Register;
1348
1349    procedure Register
1350      (Pattern : Pattern_Callback;
1351       Action  : Action_Callback;
1352       Session : Session_Type)
1353    is
1354       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1355
1356    begin
1357       Pattern_Action_Table.Increment_Last (Filters);
1358
1359       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1360         (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1361          Action  => new Actions.Simple_Action'(Proc => Action));
1362    end Register;
1363
1364    procedure Register
1365      (Pattern : Pattern_Callback;
1366       Action  : Action_Callback)
1367    is
1368    begin
1369       Register (Pattern, Action, Cur_Session);
1370    end Register;
1371
1372    procedure Register
1373      (Action  : Action_Callback;
1374       Session : Session_Type)
1375    is
1376    begin
1377       Register (Always_True'Access, Action, Session);
1378    end Register;
1379
1380    procedure Register
1381      (Action  : Action_Callback)
1382    is
1383    begin
1384       Register (Action, Cur_Session);
1385    end Register;
1386
1387    -----------------
1388    -- Set_Current --
1389    -----------------
1390
1391    procedure Set_Current (Session : Session_Type) is
1392    begin
1393       Cur_Session.Data := Session.Data;
1394    end Set_Current;
1395
1396    --------------------------
1397    -- Set_Field_Separators --
1398    --------------------------
1399
1400    procedure Set_Field_Separators
1401      (Separators : String       := Default_Separators;
1402       Session    : Session_Type)
1403    is
1404    begin
1405       Free (Session.Data.Separators);
1406
1407       Session.Data.Separators :=
1408         new Split.Separator'(Separators'Length, Separators);
1409
1410       --  If there is a current line read, split it according to the new
1411       --  separators.
1412
1413       if Session.Data.Current_Line /= Null_Unbounded_String then
1414          Split_Line (Session);
1415       end if;
1416    end Set_Field_Separators;
1417
1418    procedure Set_Field_Separators
1419      (Separators : String       := Default_Separators)
1420    is
1421    begin
1422       Set_Field_Separators (Separators, Cur_Session);
1423    end Set_Field_Separators;
1424
1425    ----------------------
1426    -- Set_Field_Widths --
1427    ----------------------
1428
1429    procedure Set_Field_Widths
1430      (Field_Widths : Widths_Set;
1431       Session      : Session_Type)
1432    is
1433    begin
1434       Free (Session.Data.Separators);
1435
1436       Session.Data.Separators :=
1437         new Split.Column'(Field_Widths'Length, Field_Widths);
1438
1439       --  If there is a current line read, split it according to
1440       --  the new separators.
1441
1442       if Session.Data.Current_Line /= Null_Unbounded_String then
1443          Split_Line (Session);
1444       end if;
1445    end Set_Field_Widths;
1446
1447    procedure Set_Field_Widths
1448      (Field_Widths : Widths_Set)
1449    is
1450    begin
1451       Set_Field_Widths (Field_Widths, Cur_Session);
1452    end Set_Field_Widths;
1453
1454    ----------------
1455    -- Split_Line --
1456    ----------------
1457
1458    procedure Split_Line (Session : Session_Type) is
1459       Fields : Field_Table.Instance renames Session.Data.Fields;
1460    begin
1461       Field_Table.Init (Fields);
1462       Split.Current_Line (Session.Data.Separators.all, Session);
1463    end Split_Line;
1464
1465    -------------
1466    -- Get_Def --
1467    -------------
1468
1469    function Get_Def return Session_Data_Access is
1470    begin
1471       return Def_Session.Data;
1472    end Get_Def;
1473
1474    -------------
1475    -- Set_Cur --
1476    -------------
1477
1478    procedure Set_Cur is
1479    begin
1480       Cur_Session.Data := Def_Session.Data;
1481    end Set_Cur;
1482
1483 begin
1484    --  We have declared two sessions but both should share the same data.
1485    --  The current session must point to the default session as its initial
1486    --  value. So first we release the session data then we set current
1487    --  session data to point to default session data.
1488
1489    Free (Cur_Session.Data);
1490    Cur_Session.Data := Def_Session.Data;
1491 end GNAT.AWK;