Merge branch 'master' of git@github.com:rakudo/rakudo

build/Makefile.in

@@ -96,6 +96,7 @@ BUILTINS_PIR = \
   src/builtins/any-str.pir \
   src/builtins/assign.pir \
   src/builtins/cmp.pir \
+  src/builtins/compiler.pir \
   src/builtins/control.pir \
   src/builtins/eval.pir \
   src/builtins/guts.pir \

build/PARROT_REVISION

@@ -1 +1 @@
-39025
+39288

build/gen_metaop_pir.pl

@@ -112,9 +112,8 @@
     my $is_chaining = $op_type eq 'comp' ? 1 : 0;
     push @code, qq(
         .sub 'infix:X${opname}'
-            .param pmc a
-            .param pmc b
-            .tailcall '!CROSSMETAOP'('$opname', $identity, $is_chaining, a, b)
+            .param pmc args :slurpy
+            .tailcall '!CROSSMETAOP'('$opname', $identity, $is_chaining, args :flat)
         .end\n);
 
     # Non-dwimming hyper ops.

build/gen_setting_pm.pl

@@ -28,22 +28,14 @@
 }
 
 print <<"END_SETTING";
-# Need to use all built-in classes, to import their exports.
+# Need to import all built-in classes and set \%*INC for each.
+sub SETTING_INIT() {
 END_SETTING
 s/\\/\//g for @classes;
 print join('', map {
-    my $colon_form = $_;
-    $colon_form =~ s/[\/\\]/::/g;
-    "BEGIN { \%*INC<$_> = 1 };\nuse $colon_form;\n" } @classes);
+        my $colon_form = $_;
+        $colon_form =~ s/[\/\\]/::/g;
+        "  \%*INC<$_> = 1;\n  Perl6::Compiler.import('$colon_form', ':DEFAULT', ':MANDATORY');\n"
+    } @classes);
+print "}\n";
 
-# Why yes, "OMFG" is a correct response to this hack. We need to make sure
-# that we set up %*INC properly for the pre-compiled case, and can't use
-# BEGIN blocks to preserve those changes for now.
-print <<"END_SETTING";
-Q:PIR {
-    .return (1)
-.end
-.sub '' :load :init
-};
-END_SETTING
-print join('', map { "\%*INC<$_> = 1;\n" } @classes);

lib/Safe.pm

@@ -0,0 +1,35 @@
+=begin pod
+
+=head1 NAME
+
+Safe - simplistic, crude Safe mode for Rakudo
+
+=head1 Synopsis
+
+    BEGIN { @*INC.push: 'lib' }
+    use Safe;
+    # rest of your code here, which can't use
+    # run(), qx/../ or open()
+    # (at least not easily)
+    
+=head1 Description
+
+C<Safe> crudely disables the most dangerous commands in Rakudo, right now
+C<run()>, C<qx/.../> and the C<open()> function (opening sockets is still
+allowed, though). Don't rely on it now, embedded PIR might still do very nasty
+things.
+
+=end pod
+
+module Safe {
+    my $s = -> *@a, *%h { die "operation not permitted in safe mode" };
+    Q:PIR {
+        $P0 = get_hll_namespace
+        $P1 = find_lex '$s'
+        $P0['run']  = $P1
+        $P0['open'] = $P1
+        $P0['!qx']  = $P1
+    }
+}
+
+# vim: ft=perl6

perl6.pir

@@ -109,7 +109,7 @@ USAGE
     $P0 .= $S0
   _handler:
     pop_eh
-    $P0 .= ".\n\nCopyright 2006-2008, The Perl Foundation.\n"
+    $P0 .= ".\n\nCopyright 2006-2009, The Perl Foundation.\n"
     setattribute perl6, '$version', $P0
 
     $P0 = box .RAKUDO_HLL
@@ -354,7 +354,7 @@ to the Perl 6 compiler.
   not_harness:
 
     $P0 = compreg 'perl6'
-    $P1 = $P0.'command_line'(args_str, 'encoding'=>'utf8', 'transcode'=>'ascii')
+    $P1 = $P0.'command_line'(args_str, 'encoding'=>'utf8', 'transcode'=>'ascii iso-8859-1')
 
     .include 'iterator.pasm'
     .local pmc iter
@@ -414,10 +414,10 @@ to the Perl 6 compiler.
 .end
 
 
-.sub 'fetch-library' :method
-    .param pmc request
+.sub 'load_library' :method
+    .param pmc name
+    .param pmc extra :named :slurpy
     .local pmc name, retval, library, inc_hash
-    name = request['name']
     $S0 = join '::', name
     retval = 'require'($S0, 'module'=>1)
     if null retval goto fail
@@ -445,30 +445,11 @@ Currently this does the equivalent of EXPORTALL on the core namespaces.
 =cut
 
 .namespace []
-
 .sub '' :anon :load :init
-    .local pmc perl6, nslist, nsiter
-    perl6 = get_hll_global ['Perl6'], 'Compiler'
-    nslist = split ' ', 'Any'
-    nsiter = iter nslist
-  ns_loop:
-    unless nsiter goto ns_done
-    $S0 = shift nsiter
-    $S0 .= '::EXPORT::ALL'
-    $P0 = perl6.'parse_name'($S0)
-    .local pmc ns, symiter
-    ns = get_hll_namespace $P0
-    if null ns goto ns_loop
-    symiter = iter ns
-  sym_loop:
-    unless symiter goto sym_done
-    $S0 = shift symiter
-    $P0 = ns[$S0]
-    set_global $S0, $P0
-    goto sym_loop
-  sym_done:
-    goto ns_loop
-  ns_done:
+    $P0 = get_global 'SETTING_INIT'
+    if null $P0 goto done
+    $P0()
+  done:
 .end
 
 ##  This goes at the bottom because the methods end up in the 'parrot'

src/builtins/assign.pir

@@ -463,12 +463,11 @@ src/builtins/assign.pir - assignments
     .param string opname
     .param string identity
     .param int chain
-    .param pmc a
-    .param pmc b
+    .param pmc args :slurpy
 
     # Use the X operator to get all permutation lists.
     .local pmc lists
-    lists = 'infix:X'(a, b)
+    lists = 'infix:X'(args :flat)
 
     # Go over the lists and combine them with reduce meta-op.
     .local pmc result, it, combinder

src/builtins/compiler.pir

@@ -0,0 +1,72 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/compiler.pir - various Perl6::Compiler methods
+
+=head1 Methods
+
+=over 4
+
+=cut
+
+.namespace ['Perl6';'Compiler']
+
+.sub 'import' :method
+    .param pmc exportns
+    .param pmc symbols         :slurpy
+    .param pmc options         :slurpy :named
+
+    $P0 = self.'parse_name'(exportns)
+    exportns = get_hll_namespace $P0
+    if null exportns goto end
+
+    .local pmc importns
+    importns = options['import_to']
+    if null importns goto import_caller_ns
+    $P0 = self.'parse_name'(importns)
+    importns = get_hll_namespace $P0
+    goto have_importns
+  import_caller_ns:
+    $P0 = getinterp
+    $P0 = $P0['sub';1]
+    importns = $P0.'get_namespace'()
+  have_importns:
+
+    .local pmc symbols_it
+    symbols_it = iter symbols
+  symbols_loop:
+    unless symbols_it goto symbols_done
+    .local string symtag
+    symtag = shift symbols_it
+    $S0 = substr symtag, 0, 1
+    if $S0 == ':' goto symbols_tag
+    $P0 = exportns[$S0]
+    importns[$S0] = $P0
+    goto symbols_loop
+
+  symbols_tag:
+    symtag = substr symtag, 1
+    .local pmc tagns
+    tagns = exportns.'get_name'()
+    push tagns, 'EXPORT'
+    push tagns, symtag
+    tagns = get_root_namespace tagns
+    if null tagns goto tagns_done
+    .local pmc tagns_it
+    tagns_it = iter tagns
+  tagns_loop:
+    unless tagns_it goto tagns_done
+    $S0 = shift tagns_it
+    $P0 = tagns[$S0]
+    importns[$S0] = $P0
+    goto tagns_loop
+  tagns_done:
+    goto symbols_loop
+  symbols_done:
+  end:
+.end
+
+=back
+
+=cut

src/builtins/eval.pir

@@ -39,7 +39,7 @@ itself can be found in src/builtins/control.pir.
     .local pmc compiler
     compiler = compreg lang
     # XXX FIXME:  We should allow the compiler to choose default encoding/transcode
-    .tailcall compiler.'evalfiles'(filename, 'encoding'=>'utf8', 'transcode'=>'ascii')
+    .tailcall compiler.'evalfiles'(filename, 'encoding'=>'utf8', 'transcode'=>'ascii iso-8859-1')
 
   lang_parrot:
     ##  load_bytecode currently doesn't accept non-ascii filenames (TT #65)
@@ -110,7 +110,7 @@ itself can be found in src/builtins/control.pir.
     goto inc_loop
   inc_end:
     $S0 = concat "Can't find ", basename
-    concat $S0, ' in @INC'
+    concat $S0, ' in @*INC'
     'die'($S0)
     .return (0)
 
@@ -153,15 +153,13 @@ itself can be found in src/builtins/control.pir.
     $P0 = ver['lang']
     if null $P0 goto no_hll
     lang = $P0
-    .local pmc compiler, request, library, imports, callerns
+    .local pmc compiler, library, imports, callerns
     $P0 = getinterp
     callerns = $P0['namespace';1]
     'load-language'(lang)
     compiler = compreg lang
-    request = root_new ['parrot';'Hash']
     $P0 = compiler_obj.'parse_name'(module)
-    request['name'] = $P0
-    library = compiler.'fetch-library'(request)
+    library = compiler.'load_library'($P0)
     imports = library['symbols']
     imports = imports['DEFAULT']
     .local pmc ns_iter, item

src/builtins/op.pir

@@ -596,7 +596,7 @@ Generates meta-ops for user defined operators.
     $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_reverse', full_name)
     set_hll_global reverse, $P0
     $P0 = '!FAIL'()
-    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_simple', '!CROSSMETAOP', name, $P0, 0)
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_cross', name)
     set_hll_global cross, $P0
     $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_hyper', '!HYPEROP', name, 0, 0)
     set_hll_global hyper1, $P0
@@ -640,6 +640,11 @@ Generates meta-ops for user defined operators.
     $P0 = find_lex '$delegate_to'
     .tailcall '!REDUCEMETAOP'($P0, 0, args :flat)
 .end
+.sub '!generate_meta_op_helper_cross' :outer('!generate_meta_op_sub')
+    .param pmc args :slurpy
+    $P0 = find_lex '$delegate_to'
+    .tailcall '!CROSSMETAOP'($P0, 0, 0, args :flat)
+.end
 .sub '!generate_meta_op_helper_hyper' :outer('!generate_meta_op_sub')
     .param pmc a
     .param pmc b

src/classes/IO.pir

@@ -16,38 +16,8 @@ This file implements the IO file handle class.
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     $P0 = p6meta.'new_class'('IO', 'parent'=>'Any', 'attr'=>'$!PIO $!ins')
     $P0.'!MUTABLE'()
-
-    $P0 = get_hll_namespace ['IO']
-    '!EXPORT'('get', 'from'=>$P0)
 .end
 
-=head2 Methods
-
-=over 4
-
-.namespace ['IO']
-
-=item get
-
-Reads a line from the file handle.
-
-=cut
-
-.sub 'get' :method
-    .local pmc pio, ins
-    pio = getattribute self, "$!PIO"
-    ins = getattribute self, "$!ins"
-    'prefix:++'(ins)
-    setattribute self, "$!ins", ins
-    pio = '!DEREF'(pio)
-    $P0 = pio.'readline'()
-    $P1 = get_hll_global 'chomp'
-    .tailcall $P1($P0)
-.end
-
-
-=back
-
 =head2 Functions
 
 =over 4

src/parser/grammar.pg

@@ -917,27 +917,29 @@ token quote {
     | <.before '<<' | '«'>  <quote_expression: :ww :qq>
     | <.before '<' >   <quote_expression: :w :q>
     | <.before '/'>    <quote_expression: :regex>
-    | [m|rx] <.ws> 
-        [ [':P5'|':Perl5'] <.ws> <quote_expression: :regex :P5>
+    | [m|rx] <.nofun> <.ws> 
+        [ [':P5'|':Perl5'] <.nofun> <.ws> <quote_expression: :regex :P5>
         |              <quote_expression: :regex>
         ]
     | qq [ <.ws> ':' ]?
-        [ w <.ws>         <quote_expression: :qq :w>
-        | $<x>=[x?] <.ws> <quote_expression: :qq>
+        [ w         <.nofun> <.ws> <quote_expression: :qq :w>
+        | $<x>=[x?] <.nofun> <.ws> <quote_expression: :qq>
         ]
     | q [ <.ws> ':' ]?
-        [ q <.ws>         <quote_expression: :qq>
-        | w <.ws>         <quote_expression: :q :w>
-        | 'PIR' <.ws>     <quote_expression: :PIR>
-        | $<x>=[x?] <.ws> <quote_expression: :q>
+        [ q         <.nofun> <.ws> <quote_expression: :qq>
+        | w         <.nofun> <.ws> <quote_expression: :q :w>
+        | PIR       <.nofun> <.ws> <quote_expression: :PIR>
+        | $<x>=[x?] <.nofun> <.ws> <quote_expression: :q>
         ]
     | Q [ <.ws> ':' ]?
-        [ 'PIR' <.ws>     <quote_expression: :PIR>
-        | 'q'   <.ws>     <quote_expression: :q>
-        | 'qq'  <.ws>     <quote_expression: :qq>
-        | 'b'   <.ws>     <quote_expression: :b>
-        | $<x>=[x?] <.ws> <quote_expression: >
+        [ PIR       <.nofun> <.ws> <quote_expression: :PIR>
+        | q         <.nofun> <.ws> <quote_expression: :q>
+        | qq        <.nofun> <.ws> <quote_expression: :qq>
+        | b         <.nofun> <.ws> <quote_expression: :b>
+        | $<x>=[x?] <.nofun> <.ws> <quote_expression: >
         ]
+    | s <.nofun> <.ws> <quote_expression: :q> 
+        <.panic: 's/// not implemented, try .subst as workaround'>
     ]
     {*}
 }