Preprocess-Ops
view release on metacpan or search on metacpan
lib/Preprocess/Ops.pm view on Meta::CPAN
#D1 Preprocess # Preprocess â—, â—€, â–· and â–¶ as operators in ANSI-C.
sub trimComment($) #P Remove trailing white space and comment
{my ($s) = @_; # String
$s =~ s(\s*//.*\n) ()r;
}
sub method($) #P Check whether a line of C code defines a method, returning (return, name, flags, comment) if it is, else ()
{my ($line) = @_; # Line of C code
return () if $line =~ m(test.*//T\S); # Tests are never methods
if ($line =~ m(\Astatic\s*(.*?)((?:\w|\$)+)\s+//(\w*)\s*(.*)\Z)) # Static function is always a method
{return ($1, $2, $3, $4)
}
if ($line =~ m(\A(.*?)(new(?:\w|\$)+)\s+//(\w*)\s*(.*)\Z)) # Constructor is always a method
{return ($1, $2, $3, $4);
}
()
}
sub structure($) #P Check whether a line of C code defines a structure, returning (name, flags, comment) if it is, else ()
{my ($line) = @_; # Line of C code
if ($line =~ m(\A(typedef\s+)?struct\s+((?:\w|\$)+)\s*//(w*)\s*(.*)\Z)) # struct name, comment start, flags, comment
{return ($2, $3, $4)
}
()
}
sub mapCode($) #P Find the structures and methods defined in a file
{my ($file) = @_; # Input file
my %methods; # Method descriptions
my %structures; # Structures defined
my @code = readFile($file); # Read input file
for my $line(@code) # Index of each line
{next if $line =~ m(\A//); # Ignore comment lines
my ($return, $name, $flags, $comment) = method($line); # Parse function return, name, description comment
if ($name)
{$methods{$name}++ # Return type
}
else
{my ($name, $flags, $comment) = structure($line); # Parse structure definition
if ($name)
{$structures{$name}++
}
}
}
genHash(q(PreprocessOpsMap), # Methods and structures in the C file being preprocessed
methods => \%methods, # Methods.
structures => \%structures, # Structure definitions.
);
}
sub printData($$) #P Print statement
{my ($lineNumber, $line) = @_; # Code line number, code line
my ($command, @w) = split m/\s+/, $line; # Parse print line
my @f;
for my $w(@w) # Each variable to be printed
{push @f, join ' ', $w, "=", $w =~ m((\A|\.|\->)[i-n]) ? "%lu" : "%s";
}
my $f = join " ", @f;
my $w = join ", ", @w;
my $l = $lineNumber + 1;
qq(fprintf(stderr, "Line $l: $f\\n", $w);\n);
}
sub duplicateFunction($$$) #P Duplicate the previous function with the specified changes applied
{my ($lineNumber, $inputFile, $code) = @_; # Line number of line being expanded, file containing line being expanded, lines of code
if ($$code[$lineNumber] =~ m(\A(duplicate)\s+)) # Parse duplicate statement: the words after are comma separated lists of regular expressions that change the text of the preceding function
{my ($command, @changes) = split /\s+/, $$code[$lineNumber];
my @c;
for(my $i = $lineNumber - 1; $i >= 0; --$i) # Text of preceding function to duplicate
{unshift @c, my $c = $$code[$i];
last if $c =~ m(\A\S);
}
my @r; # Resulting code
for my $change(@changes) # Apply changes
{my @C; # Code after each change
for my $c(@c) # Each change
{local $_ = $c;
for my $r(split/,/, $change) # Each re in the change
{eval $r;
confess "Cannot make change: $r in: $change\n$@\n" if $@;
}
push @C, $_; # Save accumulated changes
}
my $l = $lineNumber + 1; # Save duplicate code with accumulated changes
push @r, join '', @C;
push @r, qq(#line $l "$inputFile"\n);
}
my $r = join '', @r; # Changed code
return $r;
}
confess $$code[$lineNumber]," is not a 'duplicate' command";
}
sub includeFile($$$$$) #P Expand include files so that we can pull in code and structures from other files in the includes folder.
{my ($lineNumber, $inputFile, $cFile, $hFile, $code) = @_; # Line number of line being expanded, file containing line being expanded, output C file, output H file, line of code
if ($code =~ m(\A(include)\s+)) # Parse preprocessor statement
{my ($command, $relFile, @items) = split /\s+/, $code;
my %items = map {$_=>1} @items;
my $file = sumAbsAndRel($inputFile, $relFile);
-e $file or confess "Cannot find include file: $file\n";
my @code = readFile($file);
# my $map = mapCode($inputFile);
for(my $i = 0; $i < @code; ++$i) # Expand duplicate commands
{if ($code[$i] =~ m(\Aduplicate )) # Duplicate the previous function with changes
{$code[$i] = duplicateFunction($i, $inputFile, \@code);
}
}
my @c;
for(my $i = 0; $i < @code; ++$i) # Expand exports/include commands in included file
{my $c = $code[$i]; # With trailing comment
my $d = $c =~ s(//.*\Z) ()gsr; # Without trailing comment
if ($c =~ m(\Ainclude)) # Expand include files so that we can pull in code and structures from other files in the includes folder.
{push @c, &includeFile($i, $file, $cFile, $hFile, $d);
}
elsif ($c =~ m(\Aexports\s)) # Add exports from included package if named in the include list
{my ($command, $name, @exports) = split m/\s+/, $d; # Export command, list name, exports in list
if ($items{qq(:$name)}) # Requested this list
{for my $e(@exports) # Add exports unless they have been excluded
{$items{$e} ++ unless $items{qq(!$e)};
}
}
}
elsif (method($c) or structure($c)) # Method or structure definition
{if ($c =~ m((\S+)\s*//)) # Method or structure name
{my $item = $1;
if ($command =~ m(include) && $items {$item}) # Include specifies the exact name of the thing we want
{push @c, join ' ', "#line", $i+2, qq("$file"), "\n";
my @l;
for(; $i < @code; ++$i)
{push @l, $code[$i];
last if $code[$i] =~ m(\A })
}
if (@l) # Save included struct or method
{$l[0] =~ s(//) (//I); # Mark as included
# $l[0] =~ s/\Astatic /static __attribute__ ((unused)) /; # Mark included methods as potentially unused
push @c, @l;
}
}
}
}
}
my $l = $lineNumber + 2; # Adjust line numbers to reflect unexpanded source
return join '', @c, qq(#line $l "$inputFile"\n);
# return join '', @c;
}
confess "Unable to parse include statement:\n$code";
} # includeFile
sub c($$$;$) # Preprocess â–· and â–¶ as method dispatch operators in ANSI-C.
{my ($inputFile, $cFile, $hFile, $column) = @_; # Input file, C output file, H output file, optional start column for comments (80)
my $baseFile = fn $inputFile; # The base name of the file
my($shortBaseFile)= split /_/, $baseFile; # Base name of the file preceding first underscore
my $packageName = ucfirst $baseFile; # The package name which is used to replace $
my $commentColumn = ($column // 80) - 1; # Column in which to start comments
my %methods; # Method descriptions
my %structures; # Structures defined
my %structureParameters; # Structures used as parameters
my %testsFound; # Tests found
my %testsNeeded; # Tests needed
my @forwards; # Forward declarations of functions used as methods
my @code = readFile($inputFile); # Read code
my %exports; # Export statements encountered
for my $i(keys @code) # Execute preprocessor commands found in the source
{my $c = $code[$i];
if ($c =~ m(\A(include)\s+)) # Expand include files so that we can pull in code and structures from other files in the includes folder.
{$code[$i] = includeFile($i, $inputFile, $cFile, $hFile, $c);
}
elsif ($c =~ m(\Aduplicate )) # Duplicate the previous function with changes
{$code[$i] = duplicateFunction($i, $inputFile, \@code);
}
elsif ($c =~ m(\A(exports)\s+)) # Skip export commands in open source
{$exports{$c} = $i+1;
$code[$i] = "\n";
( run in 0.599 second using v1.01-cache-2.11-cpan-71847e10f99 )