<commit_before>#! perl

# Copyright (C) 2006-2007, The Perl Foundation.
# $Id$

use strict;
use warnings;

=head1 NAME

gen_inline.pl

=head1 SYNOPSIS

 %perl languages/tcl/tools/gen_inline.pl src/builtins/foo.tmt
                                              > src/builtins/foo.pir

=head1 DESCRIPTION

Use this script to generate PIR code based on a template describing how
the inlined tcl builtin works. Parameters specifying argument types and
subcommands can be specified, the build tool takes this and generates the
actual compiler for that command.

Many builtins need to use the same type of code, and do the same kind
of optimizations. By making the inlined versions more declarative, this
lets us do this work B<once> instead of many times, which B<should> make it
easier to inline more builtins accurately.

Currently supports the following types of arguments:
variable name, integer, channel, list, string, script, and expressions.

=cut

# helper conversion subroutines
our %conversions = (

    # type     subroutine
    bool    => '__boolean',
    channel => '__channel',
    expr    => '__expr',
    int     => '__integer',
    list    => '__list',
    script  => '__script',
    var     => '__read',
);

my $file = open_tmt( shift @ARGV );
my ( $cmd, @args ) = extract_info($file);

print ".HLL '_Tcl', ''\n";
print ".namespace [ 'builtins' ]\n";
print inlined_header( $cmd, @args );
print arg_check(@args);
print inlined_helpers(@args);
print inlined_arguments(@args);
print inlined_body( $file, @args );
print inlined_badargs( $cmd, @args );
print footer();

print ".HLL 'Tcl', 'tcl_group'\n";
print ".namespace\n";
print header( $cmd, @args );
print arg_check(@args);
print helpers(@args);
print arguments(@args);
print body( $file, @args );
print badargs( $cmd, @args );
print footer();

sub open_tmt {
    my ($filename) = @_;

    open my $fh, '<', $filename
        or die "can't open '$filename' for reading";

    my @file = <$fh>;

    return \@file;
}

sub extract_info {
    my ($file) = @_;

    my $spec = shift @$file;
    die "Invalid args: '$spec'\n"
        unless $spec =~ /\[ (\w+) (?: \s+ (.+?) )? \]/x;

    my $cmd  = $1;
    my $args = $2;<commit_msg>[languages] last straggler Tcl update to use ".namespace []" as per rt#48549. DietCoke++ for finding it.<commit_after>#! perl

# Copyright (C) 2006-2007, The Perl Foundation.
# $Id$

use strict;
use warnings;

=head1 NAME

gen_inline.pl

=head1 SYNOPSIS

 %perl languages/tcl/tools/gen_inline.pl src/builtins/foo.tmt
                                              > src/builtins/foo.pir

=head1 DESCRIPTION

Use this script to generate PIR code based on a template describing how
the inlined tcl builtin works. Parameters specifying argument types and
subcommands can be specified, the build tool takes this and generates the
actual compiler for that command.

Many builtins need to use the same type of code, and do the same kind
of optimizations. By making the inlined versions more declarative, this
lets us do this work B<once> instead of many times, which B<should> make it
easier to inline more builtins accurately.

Currently supports the following types of arguments:
variable name, integer, channel, list, string, script, and expressions.

=cut

# helper conversion subroutines
our %conversions = (

    # type     subroutine
    bool    => '__boolean',
    channel => '__channel',
    expr    => '__expr',
    int     => '__integer',
    list    => '__list',
    script  => '__script',
    var     => '__read',
);

my $file = open_tmt( shift @ARGV );
my ( $cmd, @args ) = extract_info($file);

print ".HLL '_Tcl', ''\n";
print ".namespace [ 'builtins' ]\n";
print inlined_header( $cmd, @args );
print arg_check(@args);
print inlined_helpers(@args);
print inlined_arguments(@args);
print inlined_body( $file, @args );
print inlined_badargs( $cmd, @args );
print footer();

print ".HLL 'Tcl', 'tcl_group'\n";
print ".namespace []\n";
print header( $cmd, @args );
print arg_check(@args);
print helpers(@args);
print arguments(@args);
print body( $file, @args );
print badargs( $cmd, @args );
print footer();

sub open_tmt {
    my ($filename) = @_;

    open my $fh, '<', $filename
        or die "can't open '$filename' for reading";

    my @file = <$fh>;

    return \@file;
}

sub extract_info {
    my ($file) = @_;

    my $spec = shift @$file;
    die "Invalid args: '$spec'\n"
        unless $spec =~ /\[ (\w+) (?: \s+ (.+?) )? \]/x;

    my $cmd  = $1;
    my $args = $2;
{'fraction_non_alphanumeric': 0.13488164359088878, 'fraction_numerical': 0.006922733363108531, 'mean_word_length': 3.3233590733590734, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7568213', 'n_tokens_mistral': 1491, 'n_tokens_neox': 1425, 'n_words': 520}