Merge pull request #744 from holli-holzer/master

Solutions by Markus Holzer

3 files changed, 110 insertions, 17 deletions

diff --git a/challenge-029/markus-holzer/README b/challenge-029/markus-holzer/README
index 5caaa53cc7..d01b41eafd 100644
--- a/challenge-029/markus-holzer/README
+++ b/challenge-029/markus-holzer/README
@@ -1,17 +1 @@
-Solutions by Markus Holzer.
-
-Solution #1 requires the external command `file`
-For Windows that program is available at
-
-http://gnuwin32.sourceforge.net/packages/file.htm
-
-To make the clock tick on Windows, solution #2 requires a module
-I wrote which is not on CPAN yet: Win::VT (Name is likely to change).
-The module enables the terminal emulation in the "DOS" prompt.
-
-To run the script you need to say
-
-> chcp 65001
-> perl6 -MWin::VT::Auto::O ch-2.pl6 --at=2,2
-
-I included the module. It is not to be considered part of the challenge.
\ No newline at end of file
+Solutions by Markus Holzer.
\ No newline at end of file
diff --git a/challenge-029/markus-holzer/perl6/ch-1.pl6 b/challenge-029/markus-holzer/perl6/ch-1.pl6
new file mode 100644
index 0000000000..f979619a00
--- /dev/null
+++ b/challenge-029/markus-holzer/perl6/ch-1.pl6
@@ -0,0 +1,89 @@
+use Test;
+use Data::Dump;
+
+my %tests =
+
+    #well-formed
+     'A{1..3}'          => ["A1", "A2", "A3"],
+     'B{1..6..2}'       => ["B1", "B3", "B5"],
+     'B{6..2..2}'       => ["B6", "B4", "B2"],
+     'B{6..2..-2}'      => ["B6", "B4", "B2"],
+     'C{a..c}'          => ["Ca", "Cb", "Cc"],
+     'C{c..a}'          => ["Cc", "Cb", "Ca"],
+     'D{a..f..2}'       => ["Da", "Dc", "De"],
+     'D{f..a..2}'       => ["Df", "Dd", "Db"],
+     'D{f..a..-2}'      => ["Df", "Dd", "Db"],
+     'E{1,2}'           => ["E1", "E2"],
+     'F{1,2,3}'         => ["F1", "F2", "F3"],
+
+    #malformed
+    'A{a..c..d}'       => ['A{a..c..d}'],
+
+    #nested
+    'Ba..z..{1,2,3}'   => ["Ba..z..1", "Ba..z..2", "Ba..z..3"],
+    'C{a,b,{1,2,3}}'   => ["Ca", "Cb", "C1", "C2", "C3"],
+
+    #multiple
+    '{a..b}X{1,2}'     => ["aX1", "bX1", "aX2", "bX2"];
+
+for %tests.kv -> $test, $expected
+{
+    is-deeply( brace-expand( $test ).Array, $expected, $test );
+}
+
+grammar BraceExpansion
+{
+    regex TOP           { <start-txt> [ <list> | <range> ] <end-txt> }
+    regex start-txt     { .* <?before [<list> || <range>]> }
+    regex end-txt       { <save-char>*? }
+    regex save-char     { <-[ \" \& \( \) \` \' \; \< \> \| \{ \} ]> }
+    regex list-element  { <list> | <-[ \" \! \$ \& \( \) \` \' \; \< \> \|]>  }
+    regex a-to-z        { <[ a..z A..Z ]> }
+    regex num           { \-? <[ 0..9 ]>+ }
+    regex range         { <alpha-range> | <num-range> }
+    regex num-range     { \{ <num>  \. \. <num> [ \. \. <num> ]? \} }
+    regex alpha-range   { \{ <a-to-z> \. \. <a-to-z> [ \. \.<num> ]? \} }
+    regex list          { \{ <list-element>+ % ',' \} }
+}
+
+
+sub num-range( $match )
+{
+    my @num   = |$match<range><num-range><num>.list>>.Int;
+    my @range = @num[0] ... @num[1];
+    my $steps = ( @num[2] // 1 ).abs;
+    @range.batch( $steps )>>.[0];
+}
+
+
+sub alpha-range( $match )
+{
+    my @num = |$match<range><alpha-range><a-to-z>.list>>.Str;
+    my @range = @num[0] ... @num[1];
+    my $steps = ( $match<range><alpha-range><num> // 1 ).abs;
+    @range.batch($steps)>>.[0];
+}
+
+sub list( $match )
+{
+    $match<list><list-element>.list>>.Str;
+}
+
+sub brace-expand( $str )
+{
+    my $match = BraceExpansion.parse( $str );
+
+    my @alternatives =
+        $match<range><num-range>   ?? num-range( $match )   !!
+        $match<range><alpha-range> ?? alpha-range( $match ) !!
+        $match<list>               ?? list( $match )        !!
+        ();
+
+    return $str
+        unless @alternatives;
+
+    @alternatives
+         .map( -> $element { $match<start-txt>.Str ~ $element ~ $match<end-txt>.Str } )
+         .map( -> $result  { |brace-expand( $result ) } )
+    ;
+}
\ No newline at end of file
diff --git a/challenge-029/markus-holzer/perl6/ch-2.pl6 b/challenge-029/markus-holzer/perl6/ch-2.pl6
new file mode 100644
index 0000000000..18ebced54f
--- /dev/null
+++ b/challenge-029/markus-holzer/perl6/ch-2.pl6
@@ -0,0 +1,20 @@
+use NativeCall;
+
+constant WCHAR              = uint16;
+constant INT                = int32;
+constant UINT               = uint32;
+constant HANDLE             = Pointer[void];
+constant LPWCTSTR           = CArray[WCHAR];
+constant MB_ICONEXCLAMATION = 0x00000030;
+
+sub MessageBoxW( HANDLE, LPWCTSTR, LPWCTSTR, UINT ) is native('user32') returns INT { * };
+
+MessageBoxW( my $handle, to-c-str("Raku is awesome"), to-c-str("Hello World"), MB_ICONEXCLAMATION );
+
+sub to-c-str( Str $str ) returns CArray[WCHAR]
+{
+    my @str := CArray[WCHAR].new;
+    for ( $str.comb ).kv -> $i, $char { @str[$i] = $char.ord; }
+    @str[ $str.chars ] = 0;
+    @str;
+}