Add Configure.nqp (based on the one from plumage) and it's (somewhat …

…slimmed down) helper library.
Whiteknight · Oct 21, 2009 · 84285f4 · 84285f4
1 parent dfbfd5c
commit 84285f4
Show file tree

Hide file tree

Showing 2 changed files with 349 additions and 0 deletions.
diff --git a/Configure.nqp b/Configure.nqp
@@ -0,0 +1,47 @@
+# Purpose: Use Parrot's config info to configure our Makefile.
+#
+# Usage:
+#     parrot_nqp Configure.nqp
+
+our @ARGS;
+our %VM;
+our $OS;
+
+MAIN();
+
+sub MAIN () {
+    # Wave to the friendly users
+    say("Hello, I'm Configure. My job is to poke and prod your system");
+    say("to figure out how to build parrot-linear-algebra.\n");
+
+    # Load Parrot config and glue functions
+    load_bytecode('aux/config-helpers.pir');
+
+    # Slurp in the unconfigured Makefile text
+    my $unconfigured := slurp(@ARGS[0] || 'config/Makefile.in');
+
+    # Replace all of the @foo@ markers
+    my $replaced := subst($unconfigured, rx('\@<ident>\@'), replacement);
+
+    # Fix paths on Windows
+    if ($OS eq 'MSWin32') {
+        $replaced := subst($replaced, rx('/'), '\\');
+    }
+
+    # Spew out the final makefile
+    spew(@ARGS[1] || 'Makefile', $replaced);
+
+    # Give the user a hint of next action
+    say("Configure completed.");
+    say("You can now type '" ~ %VM<config><make> ~ "' to build parrot-linear-algebra.\n");
+    say("You may also type '" ~ %VM<config><make> ~ " test' to run the test suite.\n");
+    say("Happy Hacking,");
+    say("\tThe parrot-linear-algebra Team");
+}
+
+sub replacement ($match) {
+    my $key    := $match<ident>;
+    my $config := %VM<config>{$key} || '';
+
+    return $config;
+}
diff --git a/aux/config-helpers.pir b/aux/config-helpers.pir
@@ -0,0 +1,302 @@
+=head1 NAME
+
+Glue.pir - Rakudo "glue" builtins (functions/globals) converted for NQP
+
+
+=head1 SYNOPSIS
+
+    # Load this library
+    load_bytecode('src/lib/Glue.pbc');
+
+    # I/O
+    $contents := slurp($filename);
+    spew(  $filename, $contents);
+    append($filename, $contents);
+
+    # Regular expressions
+    $regex_object := rx($regex_source);
+    @matches := all_matches($regex, $text);
+    $edited := subst($original, $regex, $replacement);
+
+    # Global variables;
+    our $PROGRAM_NAME;
+    our @ARGS;
+    our %ENV;
+    our %VM;
+    our $OS;
+    our $OSVER;
+
+
+=cut
+
+.namespace []
+
+.include 'interpinfo.pasm'
+.include 'sysinfo.pasm'
+.include 'iglobals.pasm'
+
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over 4
+
+=item $contents := slurp($filename)
+
+Read the C<$contents> of a file as a single string.
+
+=cut
+
+.sub 'slurp'
+    .param string filename
+    .local string contents
+
+    $P0 = open filename, 'r'
+    contents = $P0.'readall'()
+    close $P0
+    .return(contents)
+.end
+
+
+=item spew($filename, $contents)
+
+Write the string C<$contents> to a file.
+
+=cut
+
+.sub 'spew'
+    .param string filename
+    .param string contents
+
+    $P0 = open filename, 'w'
+    $P0.'print'(contents)
+    close $P0
+.end
+
+
+=item append($filename, $contents)
+
+Append the string C<$contents> to a file.
+
+=cut
+
+.sub 'append'
+    .param string filename
+    .param string contents
+
+    $P0 = open filename, 'a'
+    $P0.'print'(contents)
+    close $P0
+.end
+
+
+=item $regex_object := rx($regex_source)
+
+Compile C<$regex_source> (a string representing the source code form of a
+Perl 6 Regex) into a C<$regex_object>, suitable for using in C<match()> and
+C<subst()>.
+
+=cut
+
+.sub 'rx'
+    .param string source
+
+    .local pmc p6regex, object
+    p6regex = compreg 'PGE::Perl6Regex'
+    object  = p6regex(source)
+
+    .return(object)
+.end
+
+=item @matches := all_matches($regex, $text)
+
+Find all matches (C<:g> style, not C<:exhaustive>) for C<$regex> in the
+C<$text>.  The C<$regex> must be a regex object returned by C<rx()>.
+
+=cut
+
+.sub 'all_matches'
+    .param pmc    regex
+    .param string text
+
+    # Find all matches in the original string
+    .local pmc matches, match
+    matches = root_new ['parrot';'ResizablePMCArray']
+    match   = regex(text)
+    unless match goto done_matching
+
+  match_loop:
+    push matches, match
+
+    $I0   = match.'to'()
+    match = regex(match, 'continue' => $I0)
+
+    unless match goto done_matching
+    goto match_loop
+  done_matching:
+
+    .return(matches)
+.end
+
+
+=item $edited := subst($original, $regex, $replacement)
+
+Substitute all matches of the C<$regex> in the C<$original> string with the
+C<$replacement>, and return the edited string.  The C<$regex> must be a regex
+object returned by the C<rx()> function.
+
+The C<$replacement> may be either a simple string or a sub that will be called
+with each match object in turn, and must return the proper replacement string
+for that match.
+
+=cut
+
+.sub 'subst'
+    .param string original
+    .param pmc    regex
+    .param pmc    replacement
+
+    # Find all matches in the original string
+    .local pmc matches
+    matches = all_matches(regex, original)
+
+    # Do the substitutions on a clone of the original string
+    .local string edited
+    edited = clone original
+
+    # Now replace all the matched substrings
+    .local pmc match
+    .local int offset
+    offset = 0
+  replace_loop:
+    unless matches goto done_replacing
+    match = shift matches
+
+    # Handle either string or sub replacement
+    .local string replace_string
+    $I0 = isa replacement, 'Sub'
+    if $I0 goto call_replacement_sub
+    replace_string = replacement
+    goto have_replace_string
+  call_replacement_sub:
+    replace_string = replacement(match)
+  have_replace_string:
+
+    # Perform the replacement
+    $I0  = match.'from'()
+    $I1  = match.'to'()
+    $I2  = $I1 - $I0
+    $I0 += offset
+    substr edited, $I0, $I2, replace_string
+    $I3  = length replace_string
+    $I3 -= $I2
+    offset += $I3
+    goto replace_loop
+  done_replacing:
+
+    .return(edited)
+.end
+
+=item $joined := join($delimiter, @strings)
+
+Join C<@strings> together with the specified C<$delimiter>.
+
+=cut
+
+.sub 'join'
+    .param string delim
+    .param pmc    strings
+
+    .local string joined
+    joined = join delim, strings
+
+    .return (joined)
+.end
+
+=item @pieces := split($delimiter, $original)
+
+Split the C<$original> string with the specified C<$delimiter>, which is not
+included in the resulting C<@pieces>.
+
+=cut
+
+.sub 'split'
+    .param string delim
+    .param string original
+
+    .local pmc pieces
+    pieces = split delim, original
+
+    .return (pieces)
+.end
+
+=back
+
+=head2 Global Variables
+
+=over 4
+
+=item $PROGRAM_NAME
+
+Name of running program (argv[0] in C)
+
+=item @ARGS
+
+Program's command line arguments (including options, which are NOT parsed)
+
+=item %VM
+
+Parrot configuration
+
+=item %ENV
+
+Process-wide environment variables
+
+=item $OS
+
+Operating system generic name
+
+=item $OSVER
+
+Operating system version
+
+=back
+
+=cut
+
+.sub 'onload' :anon :load :init
+    load_bytecode 'config.pbc'
+    $P0 = getinterp
+    $P1 = $P0[.IGLOBALS_CONFIG_HASH]
+    $P2 = new ['Hash']
+    $P2['config'] = $P1
+    set_hll_global '%VM', $P2
+
+    $P1 = $P0[.IGLOBALS_ARGV_LIST]
+    if $P1 goto have_args
+    unshift $P1, '<anonymous>'
+  have_args:
+    $S0 = shift $P1
+    $P2 = box $S0
+    set_hll_global '$PROGRAM_NAME', $P2
+    set_hll_global '@ARGS', $P1
+
+    $P0 = root_new ['parrot';'Env']
+    set_hll_global '%ENV', $P0
+
+    $S0 = sysinfo .SYSINFO_PARROT_OS
+    $P0 = box $S0
+    set_hll_global '$OS', $P0
+
+    $S0 = sysinfo .SYSINFO_PARROT_OS_VERSION
+    $P0 = box $S0
+    set_hll_global '$OSVER', $P0
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir: