1 package Parsers::YYLexer;
   2 #
   3 # File: YYLexer.pm
   4 # Author: Manish Sud <msud@san.rr.com>
   5 #
   6 # Copyright (C) 2024 Manish Sud. All rights reserved.
   7 #
   8 # This file is part of MayaChemTools.
   9 #
  10 # MayaChemTools is free software; you can redistribute it and/or modify it under
  11 # the terms of the GNU Lesser General Public License as published by the Free
  12 # Software Foundation; either version 3 of the License, or (at your option) any
  13 # later version.
  14 #
  15 # MayaChemTools is distributed in the hope that it will be useful, but without
  16 # any warranty; without even the implied warranty of merchantability of fitness
  17 # for a particular purpose.  See the GNU Lesser General Public License for more
  18 # details.
  19 #
  20 # You should have received a copy of the GNU Lesser General Public License
  21 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
  22 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
  23 # Boston, MA, 02111-1307, USA.
  24 #
  25 
  26 use strict;
  27 use Carp;
  28 use Exporter;
  29 use Scalar::Util ();
  30 use Parsers::Lexer;
  31 
  32 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  33 
  34 @ISA = qw(Parsers::Lexer Exporter);
  35 @EXPORT = qw();
  36 @EXPORT_OK = qw();
  37 
  38 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
  39 
  40 # Setup class variables...
  41 my($ClassName);
  42 _InitializeClass();
  43 
  44 # Overload Perl functions...
  45 use overload '""' => 'StringifyYYLexer';
  46 
  47 # Class constructor...
  48 sub new {
  49   my($Class, $Input,  @TokensSpec) = @_;
  50 
  51   # Initialize object...
  52   my $This = $Class->SUPER::new($Input,  @TokensSpec);
  53   bless $This, ref($Class) || $Class;
  54   $This->_InitializeYYLexer();
  55 
  56   return $This;
  57 }
  58 
  59 # Initialize object data...
  60 #
  61 sub _InitializeYYLexer {
  62   my($This) = @_;
  63 
  64   # File generated containing mapping of token labels to token numbers by
  65   # running command byacc with -d option on a parser definition file.
  66   #
  67   # For example, "byacc -l -P -d -b Parser Parser.yy" would generate file
  68   # Parser.tab.ph, which might contain the following tokem name and values
  69   # for a parser for a simple calculator:
  70   #
  71   #  $NUMBER=257;
  72   #  $LETTER=258;
  73   #
  74   #
  75   $This->{YYTabFile} = undef;
  76   $This->{YYTabFilePath} = undef;
  77 
  78   # Mapping of token lables to token numbers...
  79   %{$This->{YYTabDataMap}} = ();
  80 
  81   return $This;
  82 }
  83 
  84 # Initialize class ...
  85 sub _InitializeClass {
  86   #Class name...
  87 
  88   $ClassName = __PACKAGE__;
  89 }
  90 
  91 # Process tokens in YYTab file and load mapping of token labels to integers
  92 # for return during YYLex method invocation...
  93 #
  94 # Notes:
  95 #   . YYTabFile must be a complete path or available through @INC path in the
  96 #     same directory where this package is located.
  97 #   . Name of YYTabFile might start with any valid sub directory name in @INC
  98 #     For example, "Parsers/<YYTablFile>" implies the tab file in parsers sub directory
  99 #     under MayaChemTools lib directory as it would be already in @INC path.
 100 #   . YYTabFile must be explicitly set by the caller. The default YYTabFile name,
 101 #     y.tab.ph, generated by byacc is not used implicitly to avoid confusion among
 102 #     multiple distinct instances of YYLexer.
 103 #   . YYTabFile is generated by byacc during its usage with -d options and contains
 104 #     mapping of token codes to token names/labels. YYLexer used this file to map
 105 #     token lables to token codes before retuning token code and value pair back
 106 #     to yyparse function used by byacc.
 107 #   . User defined token numbers start from 257
 108 #
 109 #     The format of YYTabFile generted by byacc during generation of parser code in
 110 #     Perl code is:
 111 #
 112 #     ... ...
 113 #     $NUMBER=257;
 114 #     $ADDOP=258;
 115 #     $SUBOP=259;
 116 #     ... ..
 117 #
 118 sub SetupYYTabFile {
 119   my($This, $YYTabFile) = @_;
 120   my($YYTabFilePath, $Line, $TokenLabel, $TokenNumber);
 121 
 122   $This->{YYTabFile} = undef;
 123   $This->{YYTabFilePath} = undef;
 124   %{$This->{YYTabDataMap}} = ();
 125 
 126   if (!defined $YYTabFile) {
 127     croak "Error: ${ClassName}->SetupYYTabFile: YYTabFile must be specified...";
 128   }
 129   $This->{YYTabFile} = $YYTabFile;
 130 
 131   if (-e $YYTabFile) {
 132     $YYTabFilePath = $YYTabFile;
 133   }
 134   else {
 135     ($YYTabFilePath) = grep {-f "$_/$YYTabFile"}  @INC;
 136     if (!$YYTabFilePath) {
 137       carp "Warning: ${ClassName}->SetupYYTabFile: YYTabFile, $YYTabFile,  can't be located in \@INC path: @INC...";
 138       return $This;
 139     }
 140     $YYTabFilePath = "${YYTabFilePath}/$YYTabFile";
 141   }
 142 
 143   $This->{YYTabFilePath} = $YYTabFilePath;
 144 
 145   open YYTABFILE, "$YYTabFilePath" or die "Couldn't open $YYTabFilePath: $_\n";
 146   while ($Line = <YYTABFILE>) {
 147     ($TokenLabel, $TokenNumber) = ($Line =~ /^\$(.*?)=(.*?);$/);
 148     if (!(defined($TokenLabel) && defined($TokenNumber))) {
 149       croak "Error: ${ClassName}->SetupYYTabFile: Couldn't extract token label and number from YYTabFile $YYTabFile at line: $Line...";
 150     }
 151     if (exists $This->{YYTabDataMap}{$TokenLabel}) {
 152       carp "Warning: ${ClassName}->SetupYYTabFile: Token lable, $TokenLabel, already defined in YYTabFile $YYTabFile...";
 153     }
 154     $This->{YYTabDataMap}{$TokenLabel} = $TokenNumber;
 155   }
 156   close YYTABFILE;
 157 
 158   return $This;
 159 }
 160 
 161 # Get next available token number and any matched text from input stream
 162 # by either removing it from the input stream or simply peeking ahead.
 163 #
 164 # Supported mode values: Peek, Next. Default: Next
 165 #
 166 # Notes:
 167 #   . Token label and value pairs returned by lexer, which can't be mapped to token
 168 #     labels specified in YYTabFile are ignored.
 169 #   . Token text of length 1 returned by lexer without a corresponding explicit token label,
 170 #     which can't be mapped to a token number using Perl ord function, is ignored.
 171 #
 172 sub YYLex {
 173   my($This, $Mode) = @_;
 174   my($LexerToken, $TokenLabel, $TokenNumber, $TokenText);
 175 
 176   ($TokenLabel, $TokenNumber, $TokenText) = (undef) x 3;
 177 
 178   TOKEN: while (defined($LexerToken = $This->Lex($Mode))) {
 179     if (ref $LexerToken) {
 180       ($TokenLabel, $TokenText) = @{$LexerToken};
 181       if (exists $This->{YYTabDataMap}{$TokenLabel}) {
 182         $TokenNumber = $This->{YYTabDataMap}{$TokenLabel};
 183       }
 184       elsif ($TokenLabel =~ /^EOI$/i) {
 185         $TokenNumber = 0;
 186       }
 187     }
 188     else {
 189       $TokenText = $LexerToken;
 190     }
 191 
 192     # Check for any literals (+, - , = etc.) to generte token numbers...
 193     #
 194     if (!defined $TokenNumber) {
 195       if (length($TokenText) == 1 && ord $TokenText) {
 196         $TokenNumber = ord $TokenText;
 197       }
 198     }
 199 
 200     # Generate error message for no mapping to token numbers...
 201     if (defined $TokenNumber) {
 202       last TOKEN;
 203     }
 204     else {
 205       if (defined $TokenLabel) {
 206         carp "Warning: ${ClassName}->YYLex: Igorning token label, $TokenLabel, with matched text, $TokenText, returned by lexer and retrieving next available token or text. Token label couldn't be mapped to token numbers specified in YYTabFile generated from a parser defintion file using byacc. After updating parser definition file, a new YYTabFile containing entry for token label must be generated...";
 207       }
 208       else {
 209         carp "Warning: ${ClassName}->YYLex: Igorning token text, $TokenText, returned by lexer and retrieving next available token or text. Token text returned by lexer couldn't be mapped to token number using Perl ord function. After updating lexer token specifications and parser definition file, a new YYTabFile containing entry for a new token label to match unrecognized text must be generated...  ";
 210       }
 211       next TOKEN;
 212     }
 213   }
 214 
 215   if (!defined $LexerToken) {
 216     # Chained lexer returns undefined at end of input. So it's equivalent to EOI
 217     # token.
 218     if (exists $This->{YYTabDataMap}{EOI}) {
 219       $TokenLabel = "EOI";
 220       $TokenNumber = $This->{YYTabDataMap}{$TokenLabel};
 221       $TokenText = "0";
 222     }
 223     else {
 224       ($TokenLabel, $TokenNumber, $TokenText) = ("EOI", 0, "0");
 225     }
 226   }
 227 
 228   return ($TokenNumber, $TokenText);
 229 }
 230 
 231 # Get next available token number and text pair from input stream by removing it
 232 # from the input stream...
 233 #
 234 sub Next {
 235   my($This) = @_;
 236 
 237   return $This->YYLex();
 238 }
 239 
 240 # Get next available token number and text pair from input stream by by simply
 241 # peeking ahead and without removing it from the input stream...
 242 #
 243 sub Peek {
 244   my($This) = @_;
 245 
 246   return $This->YYLex('Peek')
 247 }
 248 
 249 # Return a curried verson of lexer: yyparse in parser generated by byacc expects it
 250 # to call without passing any argument for the YYLexer object...
 251 #
 252 sub GetYYLex {
 253   my($This) = @_;
 254 
 255   return sub { my($Mode) = @_; $This->YYLex($Mode); };
 256 }
 257 
 258 # Is it a lexer object?
 259 sub _IsYYLexer {
 260   my($Object) = @_;
 261 
 262   return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0;
 263 }
 264 
 265 # Return a string containing information about lexer...
 266 sub StringifyYYLexer {
 267   my($This) = @_;
 268   my($YYLexerString);
 269 
 270   $YYLexerString = "YYLexer: PackageName: $ClassName; " . $This->_GetYYLexerInfoString();
 271 
 272   return $YYLexerString;
 273 }
 274 
 275 # Stringigy YYTabFile token name and value information...
 276 #
 277 sub _GetYYLexerInfoString {
 278   my($This) = @_;
 279   my($YYLexerInfoString, $TokenValue, $YYTabFile, $YYTabFilePath, $YYTabDataMapString);
 280 
 281   $YYTabFile = defined $This->{YYTabFile} ? $This->{YYTabFile} : 'None';
 282   $YYTabFilePath = defined $This->{YYTabFilePath} ? $This->{YYTabFilePath} : 'None';
 283 
 284   $YYLexerInfoString = "YYTabFile: $YYTabFile; YYTabFilePath: $YYTabFilePath";
 285 
 286   $YYTabDataMapString = "YYTabDataMap: None";
 287   if (keys %{$This->{YYTabDataMap}}) {
 288     my($TokenLabel, $TokenNumber);
 289 
 290     $YYTabDataMapString = "YYTabDataMap:";
 291     for $TokenLabel (sort keys %{$This->{YYTabDataMap}}) {
 292       $TokenValue = $This->{YYTabDataMap}{$TokenLabel};
 293       $YYTabDataMapString .= " ${TokenLabel}=${TokenValue}";
 294     }
 295   }
 296 
 297   $YYLexerInfoString .= "; $YYTabDataMapString; " . $This->_GetLexerInfoString();
 298 
 299   return $YYLexerInfoString;
 300 }
 301