[svn:parrot] r43582 - in branches/one_make: . lib/Parrot tools/build

jkeenan at svn.parrot.org jkeenan at svn.parrot.org
Sun Jan 24 17:28:59 UTC 2010


Author: jkeenan
Date: Sun Jan 24 17:28:58 2010
New Revision: 43582
URL: https://trac.parrot.org/parrot/changeset/43582

Log:
Extract subroutines from h2inc.pl and place them in lib/Parrot/H2inc.pm.  This makes them potentially reusable and/or testable.

Added:
   branches/one_make/lib/Parrot/H2inc.pm   (contents, props changed)
      - copied, changed from r43581, branches/one_make/lib/Parrot/SearchOps.pm
Modified:
   branches/one_make/MANIFEST
   branches/one_make/tools/build/h2inc.pl

Modified: branches/one_make/MANIFEST
==============================================================================
--- branches/one_make/MANIFEST	Sun Jan 24 15:39:48 2010	(r43581)
+++ branches/one_make/MANIFEST	Sun Jan 24 17:28:58 2010	(r43582)
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Jan 23 04:05:44 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Jan 24 16:40:36 2010 UT
 #
 # See below for documentation on the format of this file.
 #
@@ -1126,6 +1126,7 @@
 lib/Parrot/Docs/Section/Tests.pm                            [devel]lib
 lib/Parrot/Docs/Section/Tools.pm                            [devel]lib
 lib/Parrot/Docs/Text2HTML.pm                                [devel]lib
+lib/Parrot/H2inc.pm                                         [devel]lib
 lib/Parrot/Harness/DefaultTests.pm                          [devel]lib
 lib/Parrot/Harness/Options.pm                               [devel]lib
 lib/Parrot/Harness/Smoke.pm                                 [devel]lib

Copied and modified: branches/one_make/lib/Parrot/H2inc.pm (from r43581, branches/one_make/lib/Parrot/SearchOps.pm)
==============================================================================
--- branches/one_make/lib/Parrot/SearchOps.pm	Sun Jan 24 15:39:48 2010	(r43581, copy source)
+++ branches/one_make/lib/Parrot/H2inc.pm	Sun Jan 24 17:28:58 2010	(r43582)
@@ -1,224 +1,353 @@
-package Parrot::SearchOps;
-# Copyright (C) 2008, Parrot Foundation.
+package Parrot::H2inc;
+# Copyright (C) 2010, Parrot Foundation.
 # $Id$
 
 use strict;
-use warnings;
-
 use Exporter;
-use Text::Wrap;
-use lib qw( ./lib );
-use Parrot::Configure::Utils qw( _slurp );
 our @ISA = qw( Exporter );
 our @EXPORT_OK = qw(
-    search_all_ops_files
-    help
-    usage
+    parse_file
+    perform_directive
+    generate_text
+    print_generated_file
 );
 
-sub search_all_ops_files {
-    my ($pattern, $wrap_width, $opsdir) = @_;
-    $Text::Wrap::columns = $wrap_width;
-    my @opsfiles = glob("$opsdir/*.ops");
-
-    my $total_identified = 0;
-    foreach my $f (@opsfiles) {
-        $total_identified = _search_one_ops_file(
-            $pattern, $wrap_width, $total_identified, $f,
-        );
-    }
-    return $total_identified;
-}
+=head1 NAME
 
-sub _search_one_ops_file {
-    my ($pattern, $wrap_width, $total_identified, $f) = @_;
-    my $fullpattern = qr/^=item\sB<(\w*$pattern\w*)>\(([^)]*)\)/;
-    my @paras = split /\n{2,}/, _slurp($f);
-    my %iden_paras = ();
-    for (my $i=0; $i<=$#paras; $i++) {
-        my $j = $i+1;
-        if ( $paras[$i] =~ /$fullpattern/ and $paras[$j]) {
-            $iden_paras{$i}{op} = $1;
-            $iden_paras{$i}{args} = $2;
-        }
-    }
-    if (keys %iden_paras) {
-        my @keys = keys %iden_paras;
-        my $seen = scalar @keys;
-        $total_identified += $seen;
-        _print_name(\@paras, $wrap_width, $seen);
-        my @sorted_idx = sort {$a <=> $b} @keys;
-        my %remain_paras = map {$_, 1} @keys;
-        foreach my $idx (@sorted_idx) {
-            if ($remain_paras{$idx}) {
-                my $k = _handle_indices(
-                    \%iden_paras,
-                    $idx,
-                    \%remain_paras,
-                );
-                print fill('', '', ($paras[$k])), "\n\n";
+Parrot::H2inc - Subroutines used in F<tools/build/h2inc.pl>
+
+=head1 DESCRIPTION
+
+This package exports on demand only four subroutines used in
+F<tools/build/h2inc.pl>.
+
+=head1 SUBROUTINES
+
+=head2 C<parse_file()>
+
+=over 4
+
+=item * Arguments
+
+    $directive = parse_file($in_file, $out_file);
+
+List of 2 elements: string holding name of incoming file; string holding name of outgoing file.
+
+=item * Return Value
+
+If successful, returns a hash reference.
+
+=back
+
+=cut
+
+sub parse_file {
+    my ( $in_file, $out_file) = @_;
+
+    my ( @directives, %values, $last_val, $cur, $or_continues );
+    open my $fh, '<', $in_file or die "Can't open $in_file: $!\n";
+    while ( my $line = <$fh> ) {
+        if (
+            $line =~ m!
+            &gen_from_(enum|def) \( ( [^)]* ) \)
+            (?: \s+ prefix \( (\w+) \) )?
+            (?: \s+ subst \( (s/.*?/.*?/[eig]?) \) )?
+            !x
+            )
+        {
+            $cur and die "Missing '&end_gen' in $in_file\n";
+            my $file;
+            foreach (split ' ', $2) {
+                $file = $_ if $out_file =~ /$_$/;
             }
+            $cur = {
+                type   => $1,
+                file   => $file,
+                prefix => defined $3 ? $3 : '',
+                defined $4 ? ( subst => $4 ) : (),
+            };
+            $last_val = -1;
+        }
+        elsif ( $line =~ /&end_gen\b/ ) {
+            $cur or die "Missing &gen_from_(enum|def) in $in_file\n";
+            return $cur if defined $cur->{file};
+            $cur = undef;
         }
-    }
-    return $total_identified;
-}
 
-sub _print_name {
-    my $parasref = shift;
-    my $wrap_width = shift;
-    my $count = shift;
-    NAME: for (my $i=0; $i<=$#$parasref; $i++) {
-        my $j = $i+1;
-        if ($parasref->[$i] =~ /^=head1\s+NAME/ and $parasref->[$j]) {
-            my $str = qq{\n};
-            $str .= q{-} x $wrap_width . qq{\n};
-            $str .= $parasref->[$j] .
-                q<  (> .
-                $count .
-                q< > .
-                ($count > 1 ?  q<matches> : q<match>) .
-                qq<)\n>;
-            $str .= q{-} x $wrap_width .  qq{\n};
-            $str .= qq{\n};
-            print $str;
-            last NAME;
+        $cur or next;
+
+        if ( $cur->{type} eq 'def' && $line =~ /^\s*#define\s+(\w+)\s+(-?\w+|"[^"]*")/ ) {
+            push @{ $cur->{defs} }, [ $1, $2 ];
+        }
+        elsif ( $cur->{type} eq 'enum' ) {
+            # Special case: enum value is or'd combination of other values
+            if ( $or_continues ) {
+                $or_continues = 0;
+                my $last_def = $cur->{defs}->[-1];
+                my ($k, $v) = @{$last_def};
+                my @or_values = grep {defined $_} $line =~ /^\s*(-?\w+)(?:\s*\|\s*(-?\w+))*/;
+                for my $or (@or_values) {
+                    if ( defined $values{$or} ) {
+                        $v |= $values{$or};
+                    }
+                    elsif ( $or =~ /^0/ ) {
+                        $v |= oct $or;
+                    }
+                }
+                if ($line =~ /\|\s*$/) {
+                    $or_continues = 1;
+                }
+                $values{$k} = $last_val = $v;
+                $cur->{defs}->[-1]->[1] = $v;
+            }
+            elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)\s*\|/ ) {
+                my ( $k, $v ) = ( $1, $2 );
+                my @or_values = ($v, $line =~ /\|\s*(-?\w+)/g);
+                $v = 0;
+                for my $or (@or_values) {
+                    if ( defined $values{$or} ) {
+                        $v |= $values{$or};
+                    }
+                    elsif ( $or =~ /^0/ ) {
+                        $v |= oct $or;
+                    }
+                }
+                if ($line =~ /\|\s*$/) {
+                    $or_continues = 1;
+                }
+                $values{$k} = $last_val = $v;
+                push @{ $cur->{defs} }, [ $k, $v ];
+            }
+            elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)/ ) {
+                my ( $k, $v ) = ( $1, $2 );
+                if ( defined $values{$v} ) {
+                    $v = $values{$v};
+                }
+                elsif ( $v =~ /^0/ ) {
+                    $v = oct $v;
+                }
+                $values{$k} = $last_val = $v;
+                push @{ $cur->{defs} }, [ $k, $v ];
+            }
+            elsif ( $line =~ m!^\s*(\w+)\s*(?:,\s*)?(?:/\*|$)! ) {
+                my $k = $1;
+                my $v = $values{$k} = ++$last_val;
+                push @{ $cur->{defs} }, [ $k, $v ];
+            }
         }
     }
+    $cur and die "Missing '&end_gen' in $in_file\n";
+    close $fh or die "Could not close handle to $in_file after reading: $!";
+
+    return;
 }
 
-sub _handle_indices {
-    my ($identified_ref, $idx, $remaining_ref) = @_;
-    my $j = $idx + 1;
-    my $k = $j;
-    print qq{$identified_ref->{$idx}{op}($identified_ref->{$idx}{args})\n};
-    delete $remaining_ref->{$idx};
-    if (defined $identified_ref->{$j}{op} ) {
-        $k = _handle_indices(
-            $identified_ref,
-            $j,
-            $remaining_ref,
-        );
+=head2 C<perform_directive()>
+
+=over 4
+
+=item * Arguments
+
+    $defs_ref = perform_directive($directive);
+
+Single hash reference (which is the return value from a successful run of
+C<parse_file()>.
+
+=item * Return Value
+
+Array reference.
+
+=back
+
+=cut
+
+sub perform_directive {
+    my ($d) = @_;
+
+    my @defs = prepend_prefix( $d->{prefix}, @{ $d->{defs} } );
+    if ( my $subst = $d->{subst} ) {
+        @defs = transform_name( sub { local $_ = shift; eval $subst; $_ }, @defs );
     }
-    return $k;
+    return \@defs;
 }
 
-sub usage {
-    print <<USAGE;
-    perl tools/dev/search-ops.pl [--help] [--all] ops_pattern
-USAGE
-}
+=head2 C<const_to_parrot()>
 
-sub help {
-    usage();
-    print <<HELP;
+=over 4
 
-Given a valid Perl 5 regex as an argument, the script will search inside any
-*.ops file for an opcode name that matches, dumping both its arguments and its
-description.  The program must be called from the top-level Parrot directory.
-To dump every op, call '--all' on the command line.
+=item * Arguments
 
-Example:
-> perl tools/dev/search-ops.pl load
+    $gen = join "\n", const_to_parrot(@defs);
 
-----------------------------------------------------------------------
-File: core.ops - Parrot Core Ops (2 matches)
-----------------------------------------------------------------------
+List.
 
-load_bytecode(in STR)
-Load Parrot bytecode from file \$1, and (TODO) search the library path,
-to locate the file.
+=item * Return Value
 
-loadlib(out PMC, in STR)
-Load a dynamic link library named \$2 and store it in \$1.
+String.
 
-----------------------------------------------------------------------
-File: debug.ops (1 match)
-----------------------------------------------------------------------
+=back
 
-debug_load(inconst STR)
-Load a Parrot source file for the current program.
-HELP
+=cut
+
+sub const_to_parrot {
+
+    my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
+    my $vallen = (sort { $a <=> $b } map { length($_->[1]) } @_ )[-1] ;
+
+    map {sprintf ".macro_const %-${keylen}s %${vallen}s", $_->[0], $_->[1]} @_;
 }
 
-1;
+=head2 C<const_to_perl()>
 
-=head1 NAME
+=over 4
 
-Parrot::SearchOps - functions used in tools/dev/search-ops.pl
+=item * Arguments
 
-=head1 SYNOPSIS
+    $gen = join "\n", const_to_perl(@defs);
 
-    use Parrot::SearchOps qw(
-        search_all_ops_files
-        usage
-        help
-    );
+List.
 
-    $total_identified = search_all_ops_files(
-        $pattern, $wrap_width, $opsdir
-    );
+=item * Return Value
 
-    usage();
+String.
 
-    help();
+=back
 
-=head1 DESCRIPTION
+=cut
 
-This package provides functionality for the Perl 5 program
-F<tools/dev/search-ops.pl>, designed to replace the Python program
-F<tools/docs/search-ops.py>.  It exports two subroutines on demand.
+sub const_to_perl {
 
-=head2 C<search_all_ops_files()>
+    my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
 
-B<Purpose:>  Searches all F<.ops> files in F<src/ops/> for ops codes and their
-descriptions.  Those that match the specified pattern are printed to STDOUT.
+    map {sprintf "use constant %-${keylen}s => %s;", $_->[0], $_->[1]} @_;
+}
 
-B<Arguments:>  Three scalars.
+=head2 C<transform_name()>
 
 =over 4
 
-=item * C<$pattern>
+=item * Arguments
+
+    transform_name( sub { $prefix . $_[0] }, @_ );
+
+List of two or more elements, the first element of which is a subroutine
+reference.
+
+=item * Return Value
+
+List which is a mapping of the transformations executed by the first argument
+upon the remaining arguments.
+
+=back
+
+=cut
+
+sub transform_name {
+    my $action = shift;
+
+    return map { [ $action->( $_->[0] ), $_->[1] ] } @_;
+}
+
+=head2 C<prepend_prefix()>
+
+=over 4
 
-Perl 5 regular expression.  So C<concat> will be matched by both C<concat> and
-C<n_concat>.
+=item * Arguments
 
-=item * $wrap_width
+    @defs = prepend_prefix $d->{prefix}, @{ $d->{defs} };
 
-In F<tools/dev/search-ops.pl>, this is set to C<70> characters. Can be varied
-during testing or development.
+List of two or more elements, the first element of which is a string.
 
-=item * $opsdir
+=item * Return Value
 
-In F<tools/dev/search-ops.pl>, this is set to F<src/ops/>.  Can be varied
-during testing or development.
+List.
 
 =back
 
-B<Return Value:>  Number of times the pattern was matched by ops codes in all
-files.
+=cut
+
+sub prepend_prefix {
+    my $prefix = shift;
+
+    transform_name( sub { $prefix . $_[0] }, @_ );
+}
+
+=head2 C<generate_text()>
+
+=over 4
+
+=item * Argument
+
+    $generated_text = generate_text($directive, \@defs);
+
+List of two arguments: Directive hashref; reference to array of definitions.
+
+=item * Return Value
+
+String holding main text to be printed to new file.
 
-=head2 C<usage()>
+=back
+
+=cut
 
-B<Purpose:>  Display usage statement for F<tools/dev/search-ops.pl>.
+sub generate_text {
+    my ($directive, $defs_ref) = @_;
 
-B<Arguments:>  None.
+    my $target  = $directive->{file};
+    my $generated_text;
+    if ($target =~ /\.pm$/) {
+        $generated_text = join "\n", const_to_perl(@{ $defs_ref });
+        $generated_text .= "\n1;";
+    }
+    else {
+        $generated_text = join "\n", const_to_parrot(@{ $defs_ref });
+    }
+    return $generated_text;
+}
 
-C<Return Value:>  Implicitly returns true upon success.
+=head2 C<print_generated_file()>
 
-=head2 C<help()>
+=over 4
 
-B<Purpose:>  Display usage statement and more complete help message for F<tools/dev/search-ops.pl>.
+=item * Argument
 
-B<Arguments:>  None.
+    print_generated_file( {
+        in      => $in_file,
+        out     => $out_file,
+        script  => $0,
+        gen     => $generated_text,
+    } );
+
+Hash reference.  Elements pertain to file being read, file being created,
+calling program (typically, F<tools/build/h2inc.pl>) and string of text to be
+printed to file.
 
-C<Return Value:>  Implicitly returns true upon success.
+=item * Return Value
 
-=head1 AUTHOR
+Implicitly returns true upon success.
 
-James E Keenan, adapting Python program written by Bernhard Schmalhofer.
+=back
 
 =cut
 
+sub print_generated_file {
+    my $args = shift;
+    open my $out_fh, '>', $args->{out} or die "Can't open $args->{out}: $!\n";
+    print $out_fh <<"EOF";
+# DO NOT EDIT THIS FILE.
+#
+# This file is generated automatically from
+# $args->{in} by $args->{script}
+#
+# Any changes made here will be lost.
+#
+$args->{gen}
+EOF
+    close $out_fh;
+}
+
+1;
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: branches/one_make/tools/build/h2inc.pl
==============================================================================
--- branches/one_make/tools/build/h2inc.pl	Sun Jan 24 15:39:48 2010	(r43581)
+++ branches/one_make/tools/build/h2inc.pl	Sun Jan 24 17:28:58 2010	(r43582)
@@ -9,10 +9,23 @@
 
 Generate C<.pasm> and C<.pm> files with constants based on C<.h> files.
 
+Invoked by F<make>.  Imports functions from Parrot::H2inc.
+
+=head1 USAGE
+
+    perl tools/build/h2inc.pl <input_file> <output_file>
+
 =cut
 
 use strict;
 use warnings;
+use lib qw( lib );
+use Parrot::H2inc qw(
+    parse_file
+    perform_directive
+    generate_text
+    print_generated_file
+);
 
 my $usage = "Usage: $0 <input_file> <output_file>\n";
 
@@ -33,332 +46,6 @@
     gen     => $generated_text,
 } );
 
-=head1 SUBROUTINES
-
-=head2 C<parse_file()>
-
-=over 4
-
-=item * Arguments
-
-    $directive = parse_file($in_file, $out_file);
-
-List of 2 elements: string holding name of incoming file; string holding name of outgoing file.
-
-=item * Return Value
-
-If successful, returns a hash reference.
-
-=back
-
-=cut
-
-sub parse_file {
-    my ( $in_file, $out_file) = @_;
-
-    my ( @directives, %values, $last_val, $cur, $or_continues );
-    open my $fh, '<', $in_file or die "Can't open $in_file: $!\n";
-    while ( my $line = <$fh> ) {
-        if (
-            $line =~ m!
-            &gen_from_(enum|def) \( ( [^)]* ) \)
-            (?: \s+ prefix \( (\w+) \) )?
-            (?: \s+ subst \( (s/.*?/.*?/[eig]?) \) )?
-            !x
-            )
-        {
-            $cur and die "Missing '&end_gen' in $in_file\n";
-            my $file;
-            foreach (split ' ', $2) {
-                $file = $_ if $out_file =~ /$_$/;
-            }
-            $cur = {
-                type   => $1,
-                file   => $file,
-                prefix => defined $3 ? $3 : '',
-                defined $4 ? ( subst => $4 ) : (),
-            };
-            $last_val = -1;
-        }
-        elsif ( $line =~ /&end_gen\b/ ) {
-            $cur or die "Missing &gen_from_(enum|def) in $in_file\n";
-            return $cur if defined $cur->{file};
-            $cur = undef;
-        }
-
-        $cur or next;
-
-        if ( $cur->{type} eq 'def' && $line =~ /^\s*#define\s+(\w+)\s+(-?\w+|"[^"]*")/ ) {
-            push @{ $cur->{defs} }, [ $1, $2 ];
-        }
-        elsif ( $cur->{type} eq 'enum' ) {
-            # Special case: enum value is or'd combination of other values
-            if ( $or_continues ) {
-                $or_continues = 0;
-                my $last_def = $cur->{defs}->[-1];
-                my ($k, $v) = @{$last_def};
-                my @or_values = grep {defined $_} $line =~ /^\s*(-?\w+)(?:\s*\|\s*(-?\w+))*/;
-                for my $or (@or_values) {
-                    if ( defined $values{$or} ) {
-                        $v |= $values{$or};
-                    }
-                    elsif ( $or =~ /^0/ ) {
-                        $v |= oct $or;
-                    }
-                }
-                if ($line =~ /\|\s*$/) {
-                    $or_continues = 1;
-                }
-                $values{$k} = $last_val = $v;
-                $cur->{defs}->[-1]->[1] = $v;
-            }
-            elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)\s*\|/ ) {
-                my ( $k, $v ) = ( $1, $2 );
-                my @or_values = ($v, $line =~ /\|\s*(-?\w+)/g);
-                $v = 0;
-                for my $or (@or_values) {
-                    if ( defined $values{$or} ) {
-                        $v |= $values{$or};
-                    }
-                    elsif ( $or =~ /^0/ ) {
-                        $v |= oct $or;
-                    }
-                }
-                if ($line =~ /\|\s*$/) {
-                    $or_continues = 1;
-                }
-                $values{$k} = $last_val = $v;
-                push @{ $cur->{defs} }, [ $k, $v ];
-            }
-            elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)/ ) {
-                my ( $k, $v ) = ( $1, $2 );
-                if ( defined $values{$v} ) {
-                    $v = $values{$v};
-                }
-                elsif ( $v =~ /^0/ ) {
-                    $v = oct $v;
-                }
-                $values{$k} = $last_val = $v;
-                push @{ $cur->{defs} }, [ $k, $v ];
-            }
-            elsif ( $line =~ m!^\s*(\w+)\s*(?:,\s*)?(?:/\*|$)! ) {
-                my $k = $1;
-                my $v = $values{$k} = ++$last_val;
-                push @{ $cur->{defs} }, [ $k, $v ];
-            }
-        }
-    }
-    $cur and die "Missing '&end_gen' in $in_file\n";
-    close $fh or die "Could not close handle to $in_file after reading: $!";
-
-    return;
-}
-
-=head2 C<perform_directive()>
-
-=over 4
-
-=item * Arguments
-
-    $defs_ref = perform_directive($directive);
-
-Single hash reference (which is the return value from a successful run of
-C<parse_file()>.
-
-=item * Return Value
-
-Array reference.
-
-=back
-
-=cut
-
-sub perform_directive {
-    my ($d) = @_;
-
-    my @defs = prepend_prefix( $d->{prefix}, @{ $d->{defs} } );
-    if ( my $subst = $d->{subst} ) {
-        @defs = transform_name( sub { local $_ = shift; eval $subst; $_ }, @defs );
-    }
-    return \@defs;
-}
-
-=head2 C<const_to_parrot()>
-
-=over 4
-
-=item * Arguments
-
-    $gen = join "\n", const_to_parrot(@defs);
-
-List.
-
-=item * Return Value
-
-String.
-
-=back
-
-=cut
-
-sub const_to_parrot {
-
-    my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
-    my $vallen = (sort { $a <=> $b } map { length($_->[1]) } @_ )[-1] ;
-
-    map {sprintf ".macro_const %-${keylen}s %${vallen}s", $_->[0], $_->[1]} @_;
-}
-
-=head2 C<const_to_perl()>
-
-=over 4
-
-=item * Arguments
-
-    $gen = join "\n", const_to_perl(@defs);
-
-List.
-
-=item * Return Value
-
-String.
-
-=back
-
-=cut
-
-sub const_to_perl {
-
-    my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
-
-    map {sprintf "use constant %-${keylen}s => %s;", $_->[0], $_->[1]} @_;
-}
-
-=head2 C<transform_name()>
-
-=over 4
-
-=item * Arguments
-
-    transform_name( sub { $prefix . $_[0] }, @_ );
-
-List of two or more elements, the first element of which is a subroutine
-reference.
-
-=item * Return Value
-
-List which is a mapping of the transformations executed by the first argument
-upon the remaining arguments.
-
-=back
-
-=cut
-
-sub transform_name {
-    my $action = shift;
-
-    return map { [ $action->( $_->[0] ), $_->[1] ] } @_;
-}
-
-=head2 C<prepend_prefix()>
-
-=over 4
-
-=item * Arguments
-
-    @defs = prepend_prefix $d->{prefix}, @{ $d->{defs} };
-
-List of two or more elements, the first element of which is a string.
-
-=item * Return Value
-
-List.
-
-=back
-
-=cut
-
-sub prepend_prefix {
-    my $prefix = shift;
-
-    transform_name( sub { $prefix . $_[0] }, @_ );
-}
-
-=head2 C<generate_text()>
-
-=over 4
-
-=item * Argument
-
-    $generated_text = generate_text($directive, \@defs);
-
-List of two arguments: Directive hashref; reference to array of definitions.
-
-=item * Return Value
-
-String holding main text to be printed to new file.
-
-=back
-
-=cut
-
-sub generate_text {
-    my ($directive, $defs_ref) = @_;
-
-    my $target  = $directive->{file};
-    my $generated_text;
-    if ($target =~ /\.pm$/) {
-        $generated_text = join "\n", const_to_perl(@{ $defs_ref });
-        $generated_text .= "\n1;";
-    }
-    else {
-        $generated_text = join "\n", const_to_parrot(@{ $defs_ref });
-    }
-    return $generated_text;
-}
-
-=head2 C<print_generated_file()>
-
-=over 4
-
-=item * Argument
-
-    print_generated_file( {
-        in      => $in_file,
-        out     => $out_file,
-        script  => $0,
-        gen     => $generated_text,
-    } );
-
-Hash reference.  Elements pertain to file being read, file being created,
-calling program (typically, F<tools/build/h2inc.pl>) and string of text to be
-printed to file.
-
-=item * Return Value
-
-Implicitly returns true upon success.
-
-=back
-
-=cut
-
-sub print_generated_file {
-    my $args = shift;
-    open my $out_fh, '>', $args->{out} or die "Can't open $args->{out}: $!\n";
-    print $out_fh <<"EOF";
-# DO NOT EDIT THIS FILE.
-#
-# This file is generated automatically from
-# $args->{in} by $args->{script}
-#
-# Any changes made here will be lost.
-#
-$args->{gen}
-EOF
-    close $out_fh;
-}
-
-1;
 
 # Local Variables:
 #   mode: cperl


More information about the parrot-commits mailing list