Merge branch 'bindrets'

src/Perl6/Actions.pm

@@ -692,6 +692,7 @@ method declarator($/) {
         for @($decls) {
             $list.push(declare_variable($/, $_, $_<sigil>, $_<twigil>, $_<desigilname>, $_<traits>));
         }
+        $list<signature_from_declarator> := $<signature>.ast;
         make $list;
     }
     else {
@@ -1975,12 +1976,12 @@ sub add_signature($block, $sig_obj, $lazy) {
         $block[0].push(PAST::Block.new(
             :name($sig_setup_block_name),
             :blocktype('declaration'),
-            $sig_obj.ast
+            $sig_obj.ast(1)
         ));
         $sig_setup_block_name
     }
     else {
-        $block.loadinit.push($sig_obj.ast);
+        $block.loadinit.push($sig_obj.ast(1));
         $block.loadinit.push(PAST::Op.new( :inline('    setprop block, "$!signature", signature') ));
     }
 }

src/Perl6/Compiler/Signature.pm

@@ -13,6 +13,14 @@ class Perl6::Compiler::Signature;
 
 has $!entries;
 has $!default_type;
+has $!bind_target;
+
+
+# Accessor for $!bind_target.
+method bind_target($bind_target?) {
+    if $bind_target { $!bind_target := $bind_target }
+    $!bind_target
+}
 
 
 # Adds a parameter to the signature.
@@ -161,7 +169,7 @@ method set_rw_by_default() {
 
 # Produces an AST for generating a low-level signature object. Optionally can
 # instead produce code to generate a high-level signature object.
-method ast($high_level?) {
+method ast($low_level?) {
     my $ast     := PAST::Stmts.new();
     my @entries := self.entries;
     my $SIG_ELEM_BIND_CAPTURE       := 1;
@@ -289,7 +297,7 @@ method ast($high_level?) {
         my $sub_sig := $null_reg;
         if pir::defined__IP($_.sub_signature) {
             $sub_sig := PAST::Stmts.new();
-            $sub_sig.push( $_.sub_signature.ast );
+            $sub_sig.push( $_.sub_signature.ast(1) );
             $sub_sig.push( PAST::Var.new( :name('signature'), :scope('register') ) );
         }
 
@@ -312,21 +320,29 @@ method ast($high_level?) {
     }
 
     # If we had to build a high-level signature, do so.
-    if ($high_level) {
-        $ast.push(PAST::Op.new(
-            :pasttype('callmethod'),
-            :name('new'),
-            PAST::Var.new( :name('Signature'),, :scope('package') ),
-            PAST::Var.new( :name($sig_var.name()), :scope('register'), :named('ll_sig') )
-        ));
-    }
-    else {
+    if ($low_level) {
         $ast.push(PAST::Op.new(
             :pasttype('bind'),
             PAST::Var.new( :name('signature'), :scope('register'), :isdecl(1) ),
             $sig_var
         ));
     }
+    else {
+        my $node := PAST::Op.new(
+            :pasttype('callmethod'),
+            :name('new'),
+            PAST::Var.new( :name('Signature'),, :scope('package') ),
+            PAST::Var.new( :name($sig_var.name()), :scope('register'), :named('ll_sig') )
+        );
+        if self.bind_target() eq 'lexical' {
+            $node.push(PAST::Op.new(
+                :named('bind_target'),
+                :inline('    %r = getinterp',
+                        '    %r = %r["lexpad"]')
+            ));
+        }
+        $ast.push($node);
+    }
 
     return $ast;
 }

src/Perl6/Grammar.pm

@@ -1153,12 +1153,20 @@ token infix:sym<?? !!> {
     <O('%conditional, :reducecheck<ternary>, :pasttype<if>')> 
 }
 
-token infix:sym<:=>   { 
-    <sym>  <O('%item_assignment')> 
-    <.panic: ":= binding not yet implemented">
+token infix:sym<:=> {
+    <sym>  <O('%item_assignment, :reducecheck<bindish_check>')>
+}
+
+method bindish_check($/) {
+    # Do we have a sigature on the LHS? If so, use that rather
+    # than the list.
+    if pir::defined__IP($/[0].ast()<signature_from_declarator>) {
+        $/[0] := $/[0].ast()<signature_from_declarator>;
+        $/[0].bind_target('lexical');
+    }
 }
 
-token infix:sym<::=>   { 
+token infix:sym<::=> {
     <sym>  <O('%item_assignment')> 
     <.panic: "::= binding not yet implemented">
 }

src/builtins/Signature.pir

@@ -16,7 +16,7 @@ P6LowLevelSig and provides higher level access to it.
 .sub 'onload' :anon :init :load
     .local pmc p6meta
     p6meta = get_hll_global ['Mu'], '$!P6META'
-    p6meta.'new_class'('Signature', 'parent'=>'Any', 'attr'=>'$!ll_sig $!param_cache')
+    p6meta.'new_class'('Signature', 'parent'=>'Any', 'attr'=>'$!ll_sig $!param_cache $!try_bind_sub $!bind_target')
 .end
 
 
@@ -105,7 +105,10 @@ Returns a C<List> of C<Parameter> descriptors.
     unless null default goto default_done
     default = '!FAIL'()
   default_done:
-    unless null sub_sig goto sub_sig_done
+    if null sub_sig goto no_sub_sig
+    sub_sig = self.'new'('ll_sig'=>sub_sig)
+    goto sub_sig_done
+  no_sub_sig:
     sub_sig = '!FAIL'()
   sub_sig_done:
 
@@ -120,6 +123,127 @@ Returns a C<List> of C<Parameter> descriptors.
     .return (result)
 .end
 
+
+=item !BIND
+
+Binds the signature into the given bind target.
+
+=cut
+
+.sub '!BIND' :method
+    .param pmc capture
+
+    # Get hold of the bind testing sub.
+    $P0 = getattribute self, '$!try_bind_sub'
+    $I0 = defined $P0
+    if $I0 goto have_try_bind_sub
+    $P0 = self.'!make_try_bind_sub'()
+  have_try_bind_sub:
+
+    # Attempt to bind and get back a hash of the bound variables.
+    .local pmc bound
+    bound = $P0(capture)
+
+    # Update the target.
+    .local pmc target, bound_it
+    target = getattribute self, '$!bind_target'
+    $I0 = defined target
+    unless $I0 goto done
+    bound_it = iter bound
+  bound_it_loop:
+    unless bound_it goto bound_it_loop_end
+    $S0 = shift bound_it
+    $P0 = bound[$S0]
+    target[$S0] = $P0
+    goto bound_it_loop
+  bound_it_loop_end:
+
+  done:
+    $P0 = get_hll_global 'True'
+    .return ($P0)
+.end
+
+
+=item !make_try_bind_sub
+
+This is terrifying. To try binding a signature, we want to have a sub so we
+have a proper lex pad to bind against, and constraints will work. However,
+it can't be the actual sub the signature is attached to, and we won't always
+need it, So, we'll "just" manufacture one on demand.
+
+=cut
+
+.sub '!make_try_bind_sub' :method
+    .local string pir
+
+    # Opening.
+    pir = <<'PIR'
+.sub ''
+    .param pmc capture
+PIR
+
+    # Generate code for parameter lexicals.
+    pir = self.'!append_pir_for_sig_vars'(self, pir, 1)
+
+    # Ending.
+    pir = concat <<'PIR'
+    bind_signature capture
+    $P0 = getinterp
+    $P0 = $P0['lexpad']
+    .return ($P0)
+.end
+PIR
+
+    # Compile and return.
+    $P0 = compreg 'PIR'
+    $P0 = $P0(pir)
+    $P0 = $P0[0]
+    $P1 = getattribute self, '$!ll_sig'
+    $P1 = descalarref $P1
+    setprop $P0, '$!signature', $P1
+    .return ($P0)
+.end
+
+.sub '!append_pir_for_sig_vars' :method
+    .param pmc sig
+    .param string pir
+    .param int i
+
+    # Go through params.
+    .local pmc params, param_it
+    params = sig.'params'()
+    param_it = iter params
+  it_loop:
+    unless param_it goto it_loop_end
+    $P0 = shift param_it
+
+    # If we have a sub-signature, emit code for that.
+    .local pmc sub_sig
+    sub_sig = $P0.'signature'()
+    $I0 = defined sub_sig
+    unless $I0 goto no_sub_sig
+    (pir, i) = self.'!append_pir_for_sig_vars'(sub_sig, pir, i)
+  no_sub_sig:
+
+    # Emit PIR for variable.
+    $S0 = $P0.'name'()
+    if null $S0 goto it_loop
+    if $S0 == '' goto it_loop
+    concat pir, '    $P'
+    $S1 = i
+    concat pir, $S1
+    concat pir, " = new ['Perl6Scalar']\n    .lex '"
+    concat pir, $S0
+    concat pir, "', $P"
+    concat pir, $S1
+    concat pir, "\n"
+    inc i
+    goto it_loop
+  it_loop_end:
+
+    .return (pir, i)
+.end
+
 =back
 
 =cut

src/core/operators.pm

@@ -177,6 +177,18 @@ our multi prefix:<|>(%h) { %h.Capture }
 our multi prefix:<|>(Capture $c) { $c }
 our multi prefix:<|>(Mu $fail) { die 'Cannot use prefix:<|> with a ' ~ $fail.WHAT; }
 
+our multi infix:<:=>(Mu $a, Mu $b) {
+    die ":= binding of variables not yet implemented";
+}
+
+our multi infix:<:=>(Signature $s, Parcel \$p) {
+    $s!BIND($p.Capture());
+}
+
+our multi infix:<:=>(Signature $s, Mu \$val) {
+    $s!BIND(Capture.new($val));
+}
+
 # XXX Wants to be a macro when we have them.
 our sub WHAT(\$x) {
     $x.WHAT