[svn:parrot] r44590 - branches/ops_pct/ext/nqp-rx/src/gen

[bacek at svn.parrot.org]

Author: bacek
Date: Tue Mar  2 11:13:18 2010
New Revision: 44590
URL: https://trac.parrot.org/parrot/changeset/44590

Log:
Update nqp settings

Modified:
   branches/ops_pct/ext/nqp-rx/src/gen/settings.pm

Modified: branches/ops_pct/ext/nqp-rx/src/gen/settings.pm
==============================================================================
--- branches/ops_pct/ext/nqp-rx/src/gen/settings.pm	Tue Mar  2 11:12:53 2010	(r44589)
+++ branches/ops_pct/ext/nqp-rx/src/gen/settings.pm	Tue Mar  2 11:13:18 2010	(r44590)
@@ -60,6 +60,8 @@
 
 sub list(*@list) { @list };
 
+
+
 # vim: ft=perl6
 # From src/settings/Hash.pm
 
@@ -176,5 +178,154 @@
 sub hash (*%h) { return %h }
 
 # vim: ft=perl6
+# From src/settings/String.pm
+
+
+
+=begin
+
+These functions add more power to the basic regex matching capability,
+including doing global matches and global substitutions.
+
+=over 4
+
+=item @matches := all_matches($regex, $text)
+
+=end
+
+sub all_matches($regex, $text) {
+    my @matches;
+
+    my  $match := $text ~~ $regex;
+    while $match {
+        @matches.push($match);
+        $match := $match.CURSOR.parse($text, :rule($regex), :c($match.to));
+    }
+
+    return @matches;
+}
+
+=begin
+
+=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 as returned by C</.../>.
+
+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.
+
+=end
+
+sub subst($original, $regex, $replacement) {
+    my @matches := all_matches($regex, $original);
+    my $edited  := pir::clone($original);
+    my $is_sub  := pir::isa($replacement, 'Sub');
+    my $offset  := 0;
+
+    for @matches -> $match {
+        my $replace_string := $is_sub ?? $replacement($match) !! $replacement;
+	my $replace_len    := pir::length($replace_string);
+	my $match_len      := $match.to - $match.from;
+	my $real_from      := $match.from + $offset;
+
+	Q:PIR{
+             $P0 = find_lex '$edited'
+	     $S0 = $P0
+	     $P1 = find_lex '$real_from'
+	     $I0 = $P1
+	     $P2 = find_lex '$match_len'
+	     $I1 = $P2
+	     $P3 = find_lex '$replace_string'
+	     $S1 = $P3
+	     substr $S0, $I0, $I1, $S1
+	     $P0 = $S0
+	};
+
+	$offset := $offset - $match_len + $replace_len;
+    }
+
+    return $edited;
+}
+
+
+# vim: ft=perl6
+# From src/settings/IO.pm
+
+=begin
+
+=head1 NAME
+
+IO.nqp - IO related functions for NQP.
+
+=head1 SYNOPSIS
+
+    # I/O
+    print('things', ' to ', 'print', ...);
+    say(  'things', ' to ', 'say',   ...);
+    $contents := slurp($filename);
+    spew(  $filename, $contents);
+    append($filename, $contents);
+
+=head1 I/O Functions
+
+Basic stdio and file I/O functions.
+
+=over 4
+
+=item $contents := slurp($filename)
+
+Read the C<$contents> of a file as a single string.
+
+=end
+
+sub slurp ($filename) {
+    my $fh       := pir::open__Pss($filename, 'r');
+    my $contents := $fh.readall;
+    pir::close($fh);
+
+    return $contents;
+}
+
+
+=begin
+
+=item spew($filename, $contents)
+
+Write the string C<$contents> to a file.
+
+=end
+
+sub spew ($filename, $contents) {
+    my $fh := pir::open__Pss($filename, 'w');
+    $fh.print($contents);
+    pir::close($fh);
+}
+
+
+=begin
+
+=item append($filename, $contents)
+
+Append the string C<$contents> to a file.
+
+=end
+
+sub append ($filename, $contents) {
+    my $fh := pir::open__Pss($filename, 'a');
+    $fh.print($contents);
+    pir::close($fh);
+}
+
+
+=begin
+
+=back
+
+=end
+
+# vim: ft=perl6
 
 # vim: set ft=perl6 nomodifiable :