develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35134 - in branches/rvar2: compilers/pct/src/PAST compilers/pct/src/PCT compilers/pct/src/POST languages/perl6 languages/perl6/src/builtins languages/perl6/src/classes languages/perl6/src/parser languages/perl6/src/pmc languages/perl6/t/00-p

From:
pmichaud
Date:
January 7, 2009 09:13
Subject:
[svn:parrot] r35134 - in branches/rvar2: compilers/pct/src/PAST compilers/pct/src/PCT compilers/pct/src/POST languages/perl6 languages/perl6/src/builtins languages/perl6/src/classes languages/perl6/src/parser languages/perl6/src/pmc languages/perl6/t/00-p
Message ID:
20090107171329.00663CB9F9@x12.develooper.com
Author: pmichaud
Date: Wed Jan  7 09:13:27 2009
New Revision: 35134

Modified:
   branches/rvar2/compilers/pct/src/PAST/Compiler.pir
   branches/rvar2/compilers/pct/src/PAST/Node.pir
   branches/rvar2/compilers/pct/src/PCT/Node.pir
   branches/rvar2/compilers/pct/src/POST/Node.pir
   branches/rvar2/languages/perl6/perl6.pir
   branches/rvar2/languages/perl6/src/builtins/assign.pir
   branches/rvar2/languages/perl6/src/builtins/globals.pir
   branches/rvar2/languages/perl6/src/builtins/guts.pir
   branches/rvar2/languages/perl6/src/classes/Array.pir
   branches/rvar2/languages/perl6/src/classes/Hash.pir
   branches/rvar2/languages/perl6/src/classes/Object.pir
   branches/rvar2/languages/perl6/src/classes/Protoobject.pir
   branches/rvar2/languages/perl6/src/classes/Signature.pir
   branches/rvar2/languages/perl6/src/parser/actions.pm
   branches/rvar2/languages/perl6/src/parser/grammar.pg
   branches/rvar2/languages/perl6/src/pmc/objectref_pmc.template
   branches/rvar2/languages/perl6/t/00-parrot/05-var.t
   branches/rvar2/languages/perl6/t/00-parrot/08-regex.t
   branches/rvar2/languages/perl6/t/pmc/objectref.t
   branches/rvar2/src/pmc/class.pmc

Log:
Second step of new branch from rvar+trunk.


Modified: branches/rvar2/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- branches/rvar2/compilers/pct/src/PAST/Compiler.pir	(original)
+++ branches/rvar2/compilers/pct/src/PAST/Compiler.pir	Wed Jan  7 09:13:27 2009
@@ -80,7 +80,7 @@
     piropsig['pow']        = 'NN+'
     piropsig['print']      = 'v*'
     piropsig['set']        = 'PP'
-    piropsig['setprop']    = 'vP~P'
+    piropsig['setprop']    = '0P~P'
     set_global '%piropsig', piropsig
 
     ##  %valflags specifies when PAST::Val nodes are allowed to
@@ -584,7 +584,7 @@
 
 =cut
 
-.sub 'as_post' :method :multi(_, ['PAST';'Node'])
+.sub 'as_post' :method :multi(_, ['PAST';'Node']) :subid('Node.as_post')
     .param pmc node
     .param pmc options         :slurpy :named
 
@@ -743,10 +743,11 @@
     unshift blockpast, node
 
     .local string name, pirflags, blocktype
-    .local pmc ns, hll
+    .local pmc subid, ns, hll
     name = node.'name'()
     pirflags = node.'pirflags'()
     blocktype = node.'blocktype'()
+    subid = node.'subid'()
     ns = node.'namespace'()
     hll = node.'hll'()
 
@@ -760,7 +761,7 @@
     ##  create a POST::Sub node for this block
     .local pmc bpost
     $P0 = get_hll_global ['POST'], 'Sub'
-    bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype, 'namespace'=>ns, 'hll'=>hll)
+    bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype, 'namespace'=>ns, 'hll'=>hll, 'subid'=>subid)
     unless pirflags goto pirflags_done
     bpost.'pirflags'(pirflags)
   pirflags_done:
@@ -1045,6 +1046,11 @@
 
     $S0 = substr signature, 0, 1
     if $S0 == 'v' goto pirop_void
+    $I0 = index '0123456789', $S0
+    if $I0 < 0 goto pirop_reg
+    $S0 = arglist[$I0]
+    ops.'result'($S0)
+    goto pirop_void
   pirop_reg:
     .local string result
     result = self.'uniquereg'($S0)
@@ -1505,6 +1511,37 @@
 .end
 
 
+=item stmts(PAST::Op node)
+
+Treat the node like a PAST::Stmts node -- i.e., invoke all the
+children and return the value of the last one.
+
+=cut
+
+.sub 'stmts' :method :multi(_, ['PAST';'Op'])
+    .param pmc node
+    .param pmc options         :slurpy :named
+
+    .const 'Sub' $P0 = 'Node.as_post'
+    .tailcall self.$P0(node, options :flat :named)
+.end
+
+
+=item null(PAST::Op node)
+
+A "no-op" node -- none of the children are processed, and
+no statements are generated.
+
+=cut
+
+.sub 'null' :method :multi(_, ['PAST';'Op'])
+    .param pmc node
+    .param pmc options         :slurpy :named
+    $P0 = get_hll_global ['POST'], 'Ops'
+    .tailcall $P0.'new'('node'=>node)
+.end
+
+
 =item return(PAST::Op node)
 
 Generate a return exception, using the first child (if any) as
@@ -1916,7 +1953,17 @@
     scope = concat " '", scope
     scope = concat scope, "'"
   scope_error_1:
-    .tailcall self.'panic'("Scope", scope, " not found for PAST::Var '", name, "'")
+    # Find the nearest named block
+    .local pmc it
+    $P0 = get_global '@?BLOCK'
+    it = iter $P0
+  scope_error_block_loop:
+    unless it goto scope_error_2
+    $P0 = shift it
+    $S0 = $P0.'name'()
+    unless $S0 goto scope_error_block_loop
+  scope_error_2:
+    .tailcall self.'panic'("Scope", scope, " not found for PAST::Var '", name, "' in ", $S0)
 .end
 
 
@@ -2156,9 +2203,6 @@
     name = node.'name'()
     name = self.'escape'(name)
 
-    .local int isdecl
-    isdecl = node.'isdecl'()
-
     .local pmc call_on, ops
     call_on = node[0]
     if null call_on goto use_self
@@ -2173,21 +2217,14 @@
     if bindpost goto attribute_bind
 
   attribute_post:
-    if isdecl goto attribute_decl
     .local pmc fetchop, storeop
     $P0 = get_hll_global ['POST'], 'Op'
     fetchop = $P0.'new'(ops, call_on, name, 'pirop'=>'getattribute')
     storeop = $P0.'new'(call_on, name, ops, 'pirop'=>'setattribute')
     .tailcall self.'vivify'(node, ops, fetchop, storeop)
 
-  attribute_decl:
-    .tailcall $P0.'new'('node'=>node)
-
   attribute_bind:
     $P0 = get_hll_global ['POST'], 'Op'
-    if isdecl goto attribute_bind_decl
-    .tailcall $P0.'new'(call_on, name, bindpost, 'pirop'=>'setattribute', 'result'=>bindpost)
-  attribute_bind_decl:
     .tailcall $P0.'new'(call_on, name, bindpost, 'pirop'=>'setattribute', 'result'=>bindpost)
 .end
 
@@ -2198,6 +2235,10 @@
 
     .local string name
     name = node.'name'()
+    if name goto have_name
+    name = self.'uniquereg'('P')
+    node.'name'(name)
+  have_name:
 
     .local pmc ops
     $P0 = get_hll_global ['POST'], 'Ops'

Modified: branches/rvar2/compilers/pct/src/PAST/Node.pir
==============================================================================
--- branches/rvar2/compilers/pct/src/PAST/Node.pir	(original)
+++ branches/rvar2/compilers/pct/src/PAST/Node.pir	Wed Jan  7 09:13:27 2009
@@ -551,7 +551,7 @@
 .end
 
 
-=item symbol(name, [attr1 => val1, attr2 => val2, ...])
+=item symbol(name [, attr1 => val1, attr2 => val2, ...])
 
 If called with named arguments, sets the symbol hash corresponding
 to C<name> in the current block.  The HLL is free to select
@@ -573,14 +573,24 @@
     symtable = new 'Hash'
     self['symtable'] = symtable
   have_symtable:
-    if attr goto set_symbol
-  get_symbol:
-    $P0 = symtable[name]
-    if null $P0 goto end
-    .return ($P0)
-  set_symbol:
+    .local pmc symbol
+    symbol = symtable[name]
+    if null symbol goto symbol_empty
+    unless attr goto attr_done
+    .local pmc it
+    it = iter attr
+  attr_loop:
+    unless it goto attr_done
+    $S0 = shift it
+    $P0 = attr[$S0]
+    symbol[$S0] = $P0
+    goto attr_loop
+  attr_done:
+    .return (symbol)
+  symbol_empty:
+    unless attr goto symbol_done
     symtable[name] = attr
-  end:
+  symbol_done:
     .return (attr)
 .end
 
@@ -660,6 +670,27 @@
     .tailcall self.'attr'('compiler_args', value, have_value)
 .end
 
+=item subid([subid])
+
+If C<subid> is provided, then sets the subid for this block.
+Returns the current subid for the block, generating a unique
+subid for the block if one does not already exist.
+
+=cut
+
+.sub 'subid' :method
+    .param pmc value           :optional
+    .param int has_value       :opt_flag
+    if has_value goto getset_value
+    $I0 = exists self['subid']
+    if $I0 goto getset_value
+    value = self.'unique'()
+    has_value = 1
+  getset_value:
+    .tailcall self.'attr'('subid', value, has_value)
+.end
+
+
 =item pirflags([pirflags])
 
 Get/set any pirflags for this block.

Modified: branches/rvar2/compilers/pct/src/PCT/Node.pir
==============================================================================
--- branches/rvar2/compilers/pct/src/PCT/Node.pir	(original)
+++ branches/rvar2/compilers/pct/src/PCT/Node.pir	Wed Jan  7 09:13:27 2009
@@ -97,6 +97,18 @@
 .end
 
 
+=item clone()
+
+Clone the node.
+
+=cut
+
+.sub 'clone' :method
+    $P0 = clone self
+    .return ($P0)
+.end
+
+
 =item unshift(child)
 
 Add C<child> to the beginning of the invocant's list of children.

Modified: branches/rvar2/compilers/pct/src/POST/Node.pir
==============================================================================
--- branches/rvar2/compilers/pct/src/POST/Node.pir	(original)
+++ branches/rvar2/compilers/pct/src/POST/Node.pir	Wed Jan  7 09:13:27 2009
@@ -207,7 +207,7 @@
     if has_value goto getset_value
     $I0 = exists self['subid']
     if $I0 goto getset_value
-    value = self.'unique'()
+    value = self.'unique'('post')
     has_value = 1
   getset_value:
     .tailcall self.'attr'('subid', value, has_value)

Modified: branches/rvar2/languages/perl6/perl6.pir
==============================================================================
--- branches/rvar2/languages/perl6/perl6.pir	(original)
+++ branches/rvar2/languages/perl6/perl6.pir	Wed Jan  7 09:13:27 2009
@@ -88,7 +88,7 @@
     setattribute perl6, '$version', $P0
 
     ##  create a list for holding the stack of nested blocks
-    $P0 = new 'List'
+    $P0 = new ['List']
     set_hll_global ['Perl6';'Grammar';'Actions'], '@?BLOCK', $P0
 
     ## create a list for holding the stack of nested packages
@@ -96,23 +96,15 @@
     $P0 = new 'List'
     set_hll_global ['Perl6';'Grammar';'Actions'], '@?PACKAGE', $P0
 
-    ## create a list for holding the stack of nested modules
-    ## (that may be roles, classes or grammars).
-    $P0 = new 'List'
-    set_hll_global ['Perl6';'Grammar';'Actions'], '@?MODULE', $P0
-
-    ## create a list for holding the stack of nested classes
-    ## (that may be classes or grammars).
+    ## create a list for holding the stack of nested package
+    ## declarators
     $P0 = new 'List'
-    set_hll_global ['Perl6';'Grammar';'Actions'], '@?CLASS', $P0
+    set_hll_global ['Perl6';'Grammar';'Actions'], '@?PKGDECL', $P0
 
-    ## create a list for holding the stack of nested roles
-    $P0 = new 'List'
-    set_hll_global ['Perl6';'Grammar';'Actions'], '@?ROLE', $P0
-
-    ## create a list for holding the stack of nested grammars
-    $P0 = new 'List'
-    set_hll_global ['Perl6';'Grammar';'Actions'], '@?GRAMMAR', $P0
+    ## create a (shared) metaclass node
+    $P0 = get_hll_global ['PAST'], 'Var'
+    $P0 = $P0.'new'( 'name'=>'metaclass', 'scope'=>'register' )
+    set_hll_global ['Perl6';'Grammar';'Actions'], '$?METACLASS', $P0
 
     ##  create a list of END blocks to be run
     $P0 = new 'List'

Modified: branches/rvar2/languages/perl6/src/builtins/assign.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/assign.pir	(original)
+++ branches/rvar2/languages/perl6/src/builtins/assign.pir	Wed Jan  7 09:13:27 2009
@@ -16,7 +16,7 @@
     .param pmc cont
     .param pmc source
 
-    source = 'Scalar'(source)
+    source = '!CALLMETHOD'('Scalar', source)
     .local pmc ro, type
     getprop ro, 'readonly', cont
     if null ro goto ro_ok
@@ -73,23 +73,41 @@
     .param pmc source
 
     ##  get the list of containers and sources
+    $P0 = new ['List']
+    splice $P0, list, 0, 0
+    list = $P0
     source = source.'list'()
     source.'!flatten'()
 
-    ##  first, temporarily mark each container with a property
-    ##  so we can clone it in source if needed
-    .local pmc it, true
-    it = iter list
+    ##  now, go through our list of containers, flattening
+    ##  any intermediate lists we find, and marking each
+    ##  container with a property so we can clone it in source
+    ##  if needed
+    .local pmc true
+    .local int i
     true = box 1
+    i = 0
   mark_loop:
-    unless it goto mark_done
-    $P0 = shift it
-    setprop $P0, 'target', true
+    $I0 = elements list
+    unless i < $I0 goto mark_done
+    .local pmc cont
+    cont = list[i]
+    $I0 = isa cont, ['ObjectRef']
+    if $I0 goto mark_next
+    $I0 = isa cont, ['Perl6Array']
+    if $I0 goto mark_next
+    $I0 = does cont, 'array'
+    unless $I0 goto mark_next
+    splice list, cont, $I0, 1
+    goto mark_loop
+  mark_next:
+    setprop cont, 'target', true
+    inc i
     goto mark_loop
   mark_done:
 
     ## now build our 'real' source list, cloning any targets we encounter
-    .local pmc slist
+    .local pmc slist, it
     slist = new 'List'
     it = iter source
   source_loop:

Modified: branches/rvar2/languages/perl6/src/builtins/globals.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/globals.pir	(original)
+++ branches/rvar2/languages/perl6/src/builtins/globals.pir	Wed Jan  7 09:13:27 2009
@@ -75,6 +75,10 @@
     config = interp[.IGLOBALS_CONFIG_HASH]
     vm['config'] = config
     set_hll_global "%VM", vm
+
+    ## the default value for new ObjectRefs
+    $P0 = 'undef'()
+    set_hll_global '$!OBJECTREF', $P0
 .end
 
 

Modified: branches/rvar2/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/guts.pir	(original)
+++ branches/rvar2/languages/perl6/src/builtins/guts.pir	Wed Jan  7 09:13:27 2009
@@ -58,6 +58,36 @@
 .end
 
 
+=item !CALLMETHOD('method', obj)
+
+Invoke a method on a possibly foreign object.  If the object
+supports the requested method, we use it, otherwise we assume
+the object is foreign and try using the corresponding method
+from C<Any>.
+
+=cut
+
+.namespace []
+.sub '!CALLMETHOD'
+    .param string method
+    .param pmc obj
+    $I0 = isa obj, 'ObjectRef'
+    if $I0 goto any_method
+    $I0 = can obj, method
+    unless $I0 goto any_method
+    .tailcall obj.method()
+  any_method:
+    .local pmc anyobj
+    anyobj = get_global '$!ANY'
+    unless null anyobj goto any_method_1
+    anyobj = new 'Any'
+    set_global '$!ANY', anyobj
+  any_method_1:
+    $P0 = find_method anyobj, method
+    .tailcall obj.$P0()
+.end
+
+
 =item !VAR
 
 Helper function for implementing the VAR and .VAR macros.
@@ -336,6 +366,212 @@
 .end
 
 
+=item !meta_create(type, name, also)
+
+Create a metaclass object for C<type> with the given C<name>.  
+This simply creates a handle on which we can hang methods, attributes,
+traits, etc. -- the class itself isn't created until the class
+is composed (see C<!meta_compose> below).
+
+=cut
+
+.sub '!meta_create'
+    .param string type
+    .param string name
+    .param int also
+
+    .local pmc nsarray
+    $P0 = compreg 'Perl6'
+    nsarray = $P0.'parse_name'(name)
+
+    if type == 'class' goto class
+    if type == 'grammar' goto class
+    if type == 'role' goto role
+    'die'("Unsupported package declarator ", type)
+
+  class:
+    .local pmc metaclass, ns
+    ns = get_hll_namespace nsarray
+    if also goto is_also
+    metaclass = newclass ns
+    .return (metaclass)
+  is_also:
+    metaclass = get_class ns
+    .return (metaclass)
+
+  role:
+    .local pmc info, metarole
+    info = new 'Hash'
+    $P0 = nsarray[-1]
+    info['name'] = $P0
+    info['namespace'] = nsarray
+    metarole = new 'Role', info
+    .return (metarole)
+.end 
+
+
+=item !meta_compose(Class metaclass)
+
+Compose the class.  This includes resolving any inconsistencies
+and creating the protoobjects.
+
+=cut
+
+.sub '!meta_compose' :multi(['Class'])
+    .param pmc metaclass
+    .local pmc p6meta
+    p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+
+    p6meta.'register'(metaclass, 'parent'=>'Any')
+.end
+
+
+=item !meta_compose(Role role)
+
+Compose the role.
+
+=cut
+
+.sub '!meta_compose' :multi(['Role'])
+    .param pmc role
+    # Currently, nothing to do.
+.end
+
+
+=item !meta_trait(metaclass, type, name)
+
+Add a trait with the given C<type> and C<name> to C<metaclass>.
+
+=cut
+
+.sub '!meta_trait'
+    .param pmc metaclass
+    .param string type
+    .param string name
+
+    if type == 'trait_auxiliary:is' goto is
+    if type == 'trait_auxiliary:does' goto does
+    'die'("Unknown trait auxiliary ", type)
+  
+  is:
+    ##  get the (parrot)class object associated with name
+    $P0 = compreg 'Perl6'
+    $P0 = $P0.'parse_name'(name)
+    $P0 = get_hll_namespace $P0
+    $P0 = get_class $P0
+
+    ##  add it as parent to metaclass
+    metaclass.'add_parent'($P0)
+    .return ()
+
+  does:
+    ##  get the role to be composed
+    $P0 = compreg 'Perl6'
+    $P0 = $P0.'parse_name'(name)
+    $S0 = pop $P0
+    $P0 = get_hll_global $P0, $S0
+    $P0 = get_class $P0
+
+    ##  add it to the class.
+    metaclass.'add_role'($P0)
+.end
+
+
+=item !meta_attribute(metaclass, name, itype [, 'type'=>type] )
+
+Add attribute C<name> to C<metaclass> with the given C<itype>
+and C<type>.
+
+=cut
+
+.sub '!meta_attribute'
+    .param pmc metaclass
+    .param string name
+    .param string itype        :optional
+    .param int has_itype       :opt_flag
+    .param pmc attr            :slurpy :named
+
+    # twigil handling
+    .local string twigil
+    twigil = substr name, 1, 1
+    if twigil == '.' goto twigil_public
+    if twigil == '!' goto twigil_done
+    substr name, 1, 0, '!'
+    goto twigil_done
+  twigil_public:
+    substr name, 1, 1, '!'
+  twigil_done:
+
+    $P0 = metaclass.'attributes'()
+    $I0 = exists $P0[name]
+    if $I0 goto attr_exists
+    metaclass.'add_attribute'(name)
+    $P0 = metaclass.'attributes'()
+  attr_exists:
+
+    .local pmc attrhash, it
+    attrhash = $P0[name]
+
+    # Set any itype for the attribute.
+    unless has_itype goto itype_done
+    attrhash['itype'] = itype
+  itype_done:
+
+    # and set any other attributes that came in via the slurpy hash
+    it = iter attr
+  attr_loop:
+    unless it goto attr_done
+    $S0 = shift it
+    $P0 = attr[$S0]
+    attrhash[$S0] = $P0
+    goto attr_loop
+  attr_done:
+
+    .const 'Sub' handles = '!handles'
+    $P0 = attr['traitlist']
+    if null $P0 goto traitlist_done
+    it = iter $P0
+  traitlist_loop:
+    unless it goto traitlist_done
+    .local pmc trait
+    trait = shift it
+    $S0 = trait[0]
+    if $S0 != 'trait_verb:handles' goto traitlist_loop
+    .local pmc handles_it
+    $P0 = trait[1]
+    $P0 = 'list'($P0)
+    handles_it = iter $P0
+  handles_loop:
+    unless handles_it goto handles_done
+    $P0 = clone handles
+    $P1 = box name
+    setprop $P0, 'attrname', $P1
+    $P1 = shift handles_it
+    setprop $P0, 'methodname', $P1
+    $S1 = $P1
+    metaclass.'add_method'($S1, $P0)
+    goto handles_loop
+  handles_done:
+    goto traitlist_loop
+  traitlist_done:
+.end
+
+
+.sub '!handles' :method
+    .param pmc args            :slurpy
+    .param pmc options         :slurpy :named
+    .local pmc method, attribute
+    $P0 = getinterp
+    method = $P0['sub']
+    $P1 = getprop 'attrname', method
+    $S1 = $P1
+    attribute = getattribute self, $S1
+    $P1 = getprop 'methodname', method
+    $S1 = $P1
+    .tailcall attribute.$S1(args :flat, options :flat :named)
+.end
+
+
 =item !keyword_class(name)
 
 Internal helper method to create a class.

Modified: branches/rvar2/languages/perl6/src/classes/Array.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/classes/Array.pir	(original)
+++ branches/rvar2/languages/perl6/src/classes/Array.pir	Wed Jan  7 09:13:27 2009
@@ -251,7 +251,7 @@
   array_loop:
     unless it goto array_done
     $P0 = shift it
-    $P0 = 'Scalar'($P0)
+    $P0 = '!CALLMETHOD'('Scalar',$P0)
     $P0 = clone $P0
     push array, $P0
     goto array_loop

Modified: branches/rvar2/languages/perl6/src/classes/Hash.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/classes/Hash.pir	(original)
+++ branches/rvar2/languages/perl6/src/classes/Hash.pir	Wed Jan  7 09:13:27 2009
@@ -130,7 +130,7 @@
     key = elem.'key'()
     value = elem.'value'()
   iter_kv:
-    value = 'Scalar'(value)
+    value = '!CALLMETHOD'('Scalar', value)
     hash[key] = value
     goto iter_loop
   iter_hash:
@@ -140,7 +140,7 @@
     unless hashiter goto hashiter_done
     $S0 = shift hashiter
     value = elem[$S0]
-    value = 'Scalar'(value)
+    value = '!CALLMETHOD'('Scalar', value)
     value = clone value
     hash[$S0] = value
     goto hashiter_loop

Modified: branches/rvar2/languages/perl6/src/classes/Object.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/classes/Object.pir	(original)
+++ branches/rvar2/languages/perl6/src/classes/Object.pir	Wed Jan  7 09:13:27 2009
@@ -228,7 +228,7 @@
 =cut
 
 .namespace ['Perl6Object']
-.sub '' :method('Scalar') :anon
+.sub 'Scalar' :method
     $I0 = isa self, 'ObjectRef'
     unless $I0 goto not_ref
     .return (self)
@@ -237,21 +237,6 @@
     .return ($P0)
 .end
 
-.namespace []
-.sub 'Scalar'
-    .param pmc source
-    $I0 = isa source, 'ObjectRef'
-    if $I0 goto done
-    $I0 = can source, 'Scalar'
-    if $I0 goto can_scalar
-    $I0 = does source, 'scalar'
-    source = new 'ObjectRef', source
-  done:
-    .return (source)
-  can_scalar:
-    .tailcall source.'Scalar'()
-.end
-
 =item Str()
 
 Return a string representation of the invocant.  Default is
@@ -272,183 +257,127 @@
 
 =back
 
-=head2 Special methods
+=head2 Object constructor methods
 
 =over 4
 
-=item new()
-
-Create a new object having the same class as the invocant.
-
 =cut
 
 .namespace ['Perl6Object']
-.sub 'new' :method
-    .param pmc init_parents :slurpy
-    .param pmc init_this    :named :slurpy
+.sub 'bless' :method
+    .param pmc posargs         :slurpy
+    .param pmc attrinit        :slurpy :named
+
+    .local pmc candidate
+    candidate = self.'CREATE'()
+    .tailcall self.'BUILDALL'(candidate, attrinit)
+.end
+
+
+.sub 'BUILD' :method
+    .param pmc candidate
+    .param pmc attrinit        :slurpy :named
+
+    .local pmc p6meta, parrotclass, attributes, it
+    p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+    parrotclass = p6meta.'get_parrotclass'(self)
+    attributes = inspect parrotclass, 'attributes'
+    it = iter attributes
+  attrinit_loop:
+    unless it goto attrinit_done
+    .local string attrname
+    .local pmc attrhash, itypeclass
+    attrname = shift it
+    attrhash = attributes[attrname]
+    itypeclass = attrhash['itype']
+    unless null itypeclass goto attrinit_itype
+    $S0 = substr attrname, 0, 1
+    if $S0 == '@' goto attrinit_array
+    if $S0 == '%' goto attrinit_hash
+    itypeclass = get_class ['ObjectRef']
+    goto attrinit_itype
+  attrinit_array:
+    itypeclass = get_class ['Perl6Array']
+    goto attrinit_itype
+  attrinit_hash:
+    itypeclass = get_class ['Perl6Hash']
+  attrinit_itype:
+    .local pmc attr
+    attr = new itypeclass
+    setattribute candidate, parrotclass, attrname, attr
+    $P0 = attrhash['type']
+    setprop attr, 'type', $P0
+    .local string keyname
+    $I0 = index attrname, '!'
+    if $I0 < 0 goto attrinit_loop
+    inc $I0
+    keyname = substr attrname, $I0
+    $P0 = attrinit[keyname]
+    unless null $P0 goto attrinit_assign
+    $P0 = attrhash['init_value']
+    if null $P0 goto attrinit_loop
+  attrinit_assign:
+    'infix:='(attr, $P0)
+    goto attrinit_loop
+  attrinit_done:
+    .return (candidate)
+.end
+
+
+.sub 'BUILDALL' :method
+    .param pmc candidate
+    .param pmc attrinit
+
+    .include 'iterator.pasm'
+    .local pmc p6meta, parents, it
+    p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+    $P0 = p6meta.'get_parrotclass'(self)
+    parents = inspect $P0, 'all_parents'
+    it = iter parents
+    set it, .ITERATE_FROM_END
+  parents_loop:
+    unless it goto parents_done
+    $P0 = pop it
+    $I0 = isa $P0, 'PMCProxy'
+    if $I0 goto parents_loop
+    .local pmc parentproto
+    $P0 = getprop 'metaclass', $P0
+    parentproto = $P0.'WHAT'()
+    $I0 = can parentproto, 'BUILD'
+    unless $I0 goto parents_loop
+    parentproto.'BUILD'(candidate, attrinit :flat :named)
+    goto parents_loop
+  parents_done:
+    .return (candidate)
+.end
+
+
+=item CREATE()
+
+Create a candidate object of the type given by the invocant.
 
-    # Instantiate.
+=cut
+
+.sub 'CREATE' :method
     .local pmc p6meta
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     $P0 = p6meta.'get_parrotclass'(self)
     $P1 = new $P0
+    .return ($P1)
+.end
 
-    # If this proto object has a WHENCE auto-vivification, we should use
-    # put any values it contains but that init_this does not into init_this.
-    .local pmc whence
-    whence = self.'WHENCE'()
-    unless whence goto no_whence
-    .local pmc this_whence_iter
-    this_whence_iter = iter whence
-  this_whence_iter_loop:
-    unless this_whence_iter goto no_whence
-    $S0 = shift this_whence_iter
-    $I0 = exists init_this[$S0]
-    if $I0 goto this_whence_iter_loop
-    $P2 = whence[$S0]
-    init_this[$S0] = $P2
-    goto this_whence_iter_loop
-  no_whence:
-
-    # Now we will initialize each attribute in the class itself and it's
-    # parents with an Undef or the specified initialization value. Note that
-    # the all_parents list includes ourself.
-    .local pmc all_parents, class_iter
-    all_parents = inspect $P0, "all_parents"
-    class_iter = iter all_parents
-  class_iter_loop:
-    unless class_iter goto class_iter_loop_end
-    .local pmc cur_class
-    cur_class = shift class_iter
-
-    # If it's PMCProxy, then skip over it, since it's attribute is the delegate
-    # instance of a parent PMC class, which we should not change to Undef.
-    .local int is_pmc_proxy
-    is_pmc_proxy = isa cur_class, "PMCProxy"
-    if is_pmc_proxy goto class_iter_loop_end
-
-    # If this the current class?
-    .local pmc init_attribs
-    eq_addr cur_class, $P0, current_class
-
-    # If it's not the current class, need to see if we have any attributes.
-    # Go through the provided init_parents to see if we have anything that
-    # matches.
-    .local pmc ip_iter, cur_ip
-    ip_iter = iter init_parents
-  ip_iter_loop:
-    unless ip_iter goto ip_iter_loop_end
-    cur_ip = shift ip_iter
-
-    # We will check if their HOW matches.
-    $P2 = p6meta.'get_parrotclass'(cur_ip)
-    eq_addr cur_class, $P2, found_parent_init
-
-    goto found_init_attribs
-  ip_iter_loop_end:
-
-    # If we get here, found nothing.
-    init_attribs = new 'Hash'
-    goto parent_init_search_done
-
-    # We found some parent init data, potentially.
-  found_parent_init:
-    init_attribs = cur_ip.'WHENCE'()
-    $I0 = 'defined'(init_attribs)
-    if $I0 goto parent_init_search_done
-    init_attribs = new 'Hash'
-  parent_init_search_done:
-    goto found_init_attribs
-
-    # If it's the current class, we will take the init_this hash.
-  current_class:
-    init_attribs = init_this
-  found_init_attribs:
-
-    # Now go through attributes of the current class and iternate over them.
-    .local pmc attribs, it
-    attribs = inspect cur_class, "attributes"
-    it = iter attribs
-  iter_loop:
-    unless it goto iter_end
-    $S0 = shift it
-
-    # See if we have an init value; use Undef if not.
-    .local int got_init_value
-    $S1 = substr $S0, 2
-    got_init_value = exists init_attribs[$S1]
-    if got_init_value goto have_init_value
-    $P2 = new 'Undef'
-    goto init_done
-  have_init_value:
-    $P2 = init_attribs[$S1]
-    delete init_attribs[$S1]
-  init_done:
-
-    # Is it a scalar? If so, want a scalar container with the type set on it.
-    .local string sigil
-    sigil = substr $S0, 0, 1
-    if sigil != '$' goto no_scalar
-    .local pmc attr_info, type
-    attr_info = attribs[$S0]
-    if null attr_info goto set_attrib
-    type = attr_info['type']
-    if null type goto set_attrib
-    if got_init_value goto no_proto_init
-    $I0 = isa type, 'P6protoobject'
-    unless $I0 goto no_proto_init
-    set $P2, type
-  no_proto_init:
-    $P2 = new 'Perl6Scalar', $P2
-    setprop $P2, 'type', type
-    goto set_attrib
-  no_scalar:
-
-    # Is it an array? If so, initialize to Perl6Array.
-    if sigil != '@' goto no_array
-    $P3 = new 'Perl6Array'
-    $I0 = defined $P2
-    if $I0 goto have_array_value
-    set $P2, $P3
-    goto set_attrib
-  have_array_value:
-    'infix:='($P3, $P2)
-    set $P2, $P3
-    goto set_attrib
-  no_array:
-
-    # Is it a Hash? If so, initialize to Perl6Hash.
-    if sigil != '%' goto no_hash
-    $P3 = new 'Perl6Hash'
-    $I0 = defined $P2
-    if $I0 goto have_hash_value
-    set $P2, $P3
-    goto set_attrib
-  have_hash_value:
-    'infix:='($P3, $P2)
-    set $P2, $P3
-    goto set_attrib
-  no_hash:
-
-  set_attrib:
-    push_eh set_attrib_eh
-    setattribute $P1, cur_class, $S0, $P2
-  set_attrib_eh:
-    pop_eh
-    goto iter_loop
-  iter_end:
-
-    # Do we have anything left in the hash? If so, unknown.
-    $I0 = elements init_attribs
-    if $I0 == 0 goto init_attribs_ok
-    'die'("You passed an initialization parameter that does not have a matching attribute.")
-  init_attribs_ok:
-
-    # Next class.
-    goto class_iter_loop
-  class_iter_loop_end:
 
-    .return ($P1)
+=item new()
+
+Create a new object having the same class as the invocant.
+
+=cut
+
+.sub 'new' :method
+    .param pmc posargs         :slurpy
+    .param pmc attrinit        :slurpy :named
+
+    .tailcall self.'bless'(posargs :flat, attrinit :flat :named)
 .end
 
 =item 'PARROT'

Modified: branches/rvar2/languages/perl6/src/classes/Protoobject.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/classes/Protoobject.pir	(original)
+++ branches/rvar2/languages/perl6/src/classes/Protoobject.pir	Wed Jan  7 09:13:27 2009
@@ -73,6 +73,19 @@
 
 =back
 
+=head2  Coercions
+
+=over
+
+=item Scalar()
+
+=cut
+
+.namespace ['P6protoobject']
+.sub 'Scalar' :method
+    .return (self)
+.end
+
 =head2  Private methods
 
 =over

Modified: branches/rvar2/languages/perl6/src/classes/Signature.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/classes/Signature.pir	(original)
+++ branches/rvar2/languages/perl6/src/classes/Signature.pir	Wed Jan  7 09:13:27 2009
@@ -43,78 +43,36 @@
 
 =over 4
 
-=item !create
+=item !add_param( $varname, *%attr )
 
-Used to create a new signature object with the given paramter descriptors. The
-constraints entry that we actually get passed in here contains both class, role
-and subset types; we separate them out in here. At some point in the future, we
-should be smart enough to do this at compile time.
+Add the attributes given by C<%attr> as the entry for C<$var> in
+the Signature.
 
 =cut
 
-.sub '!create' :method
-    .param pmc parameters :slurpy
-
-    # Iterate over parameters.
-    .local pmc param_iter, cur_param
-    param_iter = iter parameters
-  param_loop:
-    unless param_iter goto param_loop_end
-    cur_param = shift param_iter
-
-    # Get constraints list, which may have class and role types as well as
-    # subset types. If we have no unique role or class type, they all become
-    # constraints; otherwise, we find the unique type. Finally, we turn the
-    # list of constraints into a junction.
-    .local pmc cur_list, cur_list_iter, constraints, type, test_item
-    constraints = 'list'()
-    type = null
-    cur_list = cur_param["constraints"]
-    cur_list_iter = iter cur_list
-
-  cur_list_loop:
-    unless cur_list_iter goto cur_list_loop_end
-    test_item = shift cur_list_iter
-    $I0 = isa test_item, "Role"
-    if $I0 goto is_type
-    $P0 = getprop "subtype_realtype", test_item
-    if null $P0 goto not_refinement
-    unless null type goto all_constraints
-    type = $P0
-    push constraints, test_item
-    goto cur_list_loop
-  not_refinement:
-    $I0 = isa test_item, "P6protoobject"
-    if $I0 goto is_type
-    push constraints, test_item
-    goto cur_list_loop
-  is_type:
-    unless null type goto all_constraints
-    type = test_item
-    goto cur_list_loop
-  all_constraints:
-    type = null
-    constraints = cur_list
-  cur_list_loop_end:
-    unless null type goto have_type
-    type = get_hll_global 'Any'
+.sub '!add_param' :method
+    .param string varname
+    .param pmc attr            :slurpy :named
+
+    attr['name'] = varname
+
+    # If no multi_invocant value, set it to 1 (meaning it is one).
+    $I0 = exists attr['multi_invocant']
+    if $I0 goto have_mi
+    attr['multi_invocant'] = 1
+  have_mi:
+
+    # For now, if no type, set it to Any.
+    $P0 = attr['type']
+    unless null $P0 goto have_type
+    $P0 = get_hll_global 'Any'
+    attr['type'] = $P0
   have_type:
-    cur_param["type"] = type
-    $I0 = elements constraints
-    if $I0 == 0 goto no_constraints
-    constraints = 'all'(constraints)
-    goto set_constraints
-  no_constraints:
-    constraints = null
-  set_constraints:
-    cur_param["constraints"] = constraints
 
-    goto param_loop
-  param_loop_end:
-
-    $P0 = self.'new'()
-    setattribute $P0, '@!params', parameters
-    .return ($P0)
+    # Add to parameters list.
+    .local pmc params
+    params = self.'params'()
+    push params, attr
 .end
 
 =item params
@@ -125,6 +83,10 @@
 
 .sub 'params' :method
     $P0 = getattribute self, "@!params"
+    unless null $P0 goto done
+    $P0 = 'list'()
+    setattribute self, "@!params", $P0
+  done:
     .return ($P0)
 .end
 
@@ -223,10 +185,82 @@
     .return (s)
 .end
 
+=item !BIND_SIGNATURE
+
+Analyze the signature of the caller, (re)binding the caller's
+lexicals as needed and performing type checks.
+
+=cut
+
+.namespace []
+.sub '!SIGNATURE_BIND'
+    .local pmc callersub, callerlex, callersig
+    $P0 = getinterp
+    callersub = $P0['sub';1]
+    callerlex = $P0['lexpad';1]
+    getprop callersig, '$!signature', callersub
+    if null callersig goto end
+    .local pmc it
+    $P0 = callersig.'params'()
+    if null $P0 goto end
+    it = iter $P0
+  param_loop:
+    unless it goto param_done
+    .local pmc param
+    param = shift it
+    .local string name, sigil
+    name = param['name']
+    sigil = substr name, 0, 1
+    .local pmc type, orig, var
+    type = param['type']
+    orig = callerlex[name]
+    if sigil == '@' goto param_array
+    if sigil == '%' goto param_hash
+    var = '!CALLMETHOD'('Scalar', orig)
+    ##  typecheck the argument
+    if null type goto param_val_done
+    .lex '$/', $P99
+    $P0 = type.'ACCEPTS'(var)
+    unless $P0 goto err_param_type
+    goto param_val_done
+  param_array:
+    var = '!CALLMETHOD'('Array', orig)
+    goto param_val_done
+  param_hash:
+    var = '!CALLMETHOD'('Hash', orig)
+  param_val_done:
+    ## handle readonly/copy traits
+    $S0 = param['readtype']
+    if $S0 == 'rw' goto param_readtype_done
+    ne_addr orig, var, param_readtype_var
+    var = new 'ObjectRef', var
+  param_readtype_var:
+    if $S0 == 'copy' goto param_readtype_done
+    $P0 = get_hll_global ['Bool'], 'True'
+    setprop var, 'readonly', $P0
+  param_readtype_done:
+    ## set any type properties
+    setprop var, 'type', type
+    ## place the updated variable back into lex
+    callerlex[name] = var
+    goto param_loop 
+  param_done:
+  end:
+    .return ()
+  err_param_type:
+    $S0 = callersub
+    if $S0 goto have_callersub_name
+    $S0 = '<anon>'
+  have_callersub_name:
+    'die'('Parameter type check failed in call to ', $S0)
+.end
+
+
 =back
 
 =cut
 
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: branches/rvar2/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rvar2/languages/perl6/src/parser/actions.pm	Wed Jan  7 09:13:27 2009
@@ -57,26 +57,22 @@
 
 
 method statement_block($/, $key) {
-    our $?BLOCK;
     our @?BLOCK;
-    our $?BLOCK_SIGNATURED;
-    ##  when entering a block, use any $?BLOCK_SIGNATURED if it exists,
+    our $?BLOCK_OPEN;
+    ##  when entering a block, use any $?BLOCK_OPEN if it exists,
     ##  otherwise create an empty block with an empty first child to
     ##  hold any parameters we might encounter inside the block.
     if $key eq 'open' {
-        if $?BLOCK_SIGNATURED {
-            $?BLOCK := $?BLOCK_SIGNATURED;
-            $?BLOCK_SIGNATURED := 0;
-            $?BLOCK.symbol('___HAVE_A_SIGNATURE', :scope('lexical'));
+        if $?BLOCK_OPEN {
+            @?BLOCK.unshift( $?BLOCK_OPEN );
+            $?BLOCK_OPEN := 0;
         }
         else {
-            $?BLOCK := PAST::Block.new( PAST::Stmts.new(), :node($/));
+            @?BLOCK.unshift( PAST::Block.new( PAST::Stmts.new(), :node($/)));
         }
-        @?BLOCK.unshift($?BLOCK);
     }
     if $key eq 'close' {
         my $past := @?BLOCK.shift();
-        $?BLOCK := @?BLOCK[0];
         $past.push($($<statementlist>));
         make $past;
     }
@@ -103,7 +99,7 @@
         $past := $( $<statement_control> );
     }
     elsif $key eq 'null' {
-        $past := PAST::Stmts.new();  # empty stmts seem eliminated by TGE
+        $past := PAST::Stmts.new();
     }
     else {
         my $sml;
@@ -233,7 +229,8 @@
 }
 
 sub when_handler_helper($block) {
-    our $?BLOCK;
+    our @?BLOCK;
+    my $?BLOCK := @?BLOCK[0];
     # XXX TODO: This isn't quite the right way to check this...
     unless $?BLOCK.handlers() {
         my @handlers;
@@ -327,8 +324,8 @@
     if $name ne 'v6' && $name ne 'lib' {
         ##  Create a loadinit node so the use module is loaded
         ##  when this module is loaded...
-        our $?BLOCK;
-        $?BLOCK.loadinit().push(
+        our @?BLOCK;
+        @?BLOCK[0].loadinit().push(
             PAST::Op.new(
                 PAST::Val.new( :value($name) ),
                 :name('use'),
@@ -381,7 +378,8 @@
         ),
         $past
     );
-    our $?BLOCK;
+    our @?BLOCK;
+    my $?BLOCK := @?BLOCK[0];
     my $eh := PAST::Control.new( $past );
     my @handlers;
     if $?BLOCK.handlers() {
@@ -408,7 +406,8 @@
         ),
         $past
     );
-    our $?BLOCK;
+    our @?BLOCK;
+    my $?BLOCK := @?BLOCK[0];
     my $eh := PAST::Control.new(
         $past,
         :handle_types('CONTROL')
@@ -512,139 +511,36 @@
 }
 
 
-method multi_declarator($/, $key) {
-    my $past := $( $/{$key} );
-
-    # If we just got a routine_def, make it a sub.
-    if $key eq 'routine_def' {
-        create_sub($/, $past);
-    }
-
-    # If we have an only, proto or multi, we must have a name.
-    if $<sym> ne "" && $past.name() eq "" {
-        $/.panic("'" ~ $<sym> ~ "' can only be used on named routines");
-    }
-
-    # If it was multi or a proto, then emit a :multi.
-    if $<sym> eq 'multi' || $<sym> eq 'proto' {
-        # For now, if this is a multi we need to add code to transform the sub's
-        # multi container to a Perl6MultiSub.
-        $past.loadinit().push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!TOPERL6MULTISUB'),
-                PAST::Var.new(
-                    :name('block'),
-                    :scope('register')
+method multi_declarator($/) {
+    my $sym  := ~$<sym>;
+    my $past :=  $<declarator> ?? $( $<declarator> ) !! $( $<routine_def> );
+
+    if $past.isa(PAST::Block) {
+        # If we have a multi declarator, must have a named routine too.
+        if $sym ne "" && $past.name() eq "" {
+            $/.panic("'" ~ $<sym> ~ "' can only be used on named routines");
+        }
+
+        # If we're declaring a multi or a proto, flag the sub as :multi,
+        # and transform the sub's container to a Perl6MultiSub.
+        if $sym eq 'multi' || $sym eq 'proto' {
+            my $pirflags := ~$past.pirflags();
+            $past.pirflags( $pirflags ~ ' :multi()' );
+            $past.loadinit().push(
+                PAST::Op.new( :name('!TOPERL6MULTISUB'), :pasttype('call'),
+                    PAST::Var.new( :name('block'), :scope('register') )
                 )
-            )
-        );
-
-        # Flag the sub as multi, but it will get the signature from the
-        # signature object, so don't worry about that here.
-        my $pirflags := $past.pirflags();
-        unless $pirflags { $pirflags := '' }
-        $past.pirflags($pirflags  ~ ' :multi()');
-    }
-
-    # Protos also need the proto property setting on them.
-    if $<sym> eq 'proto' {
-        $past.loadinit().push(
-            PAST::Op.new(
-                :inline('    setprop %0, "proto", %1'),
-                PAST::Var.new(
-                    :name('block'),
-                    :scope('register')
-                ),
-                1
-            )
-        );
-    }
-
-    make $past;
-}
-
-
-method routine_declarator($/, $key) {
-    my $past;
-    if $key eq 'sub' {
-        $past := $($<routine_def>);
-        create_sub($/, $past);
-    }
-    elsif $key eq 'method' {
-        $past := $($<method_def>);
-
-        # If it's got a name, only valid inside a class, role or grammar.
-        if $past.name() {
-            our @?CLASS;
-            our @?GRAMMAR;
-            our @?ROLE;
-            unless +@?CLASS || +@?GRAMMAR || +@?ROLE {
-                $/.panic("Named methods cannot appear outside of a class, grammar or role.");
-            }
-        }
-
-        # Add declaration of leixcal self.
-        $past[0].unshift(PAST::Op.new(
-            :pasttype('bind'),
-            PAST::Var.new(
-                :name('self'),
-                :scope('lexical'),
-                :isdecl(1)
-            ),
-            PAST::Var.new( :name('self'), :scope('register') )
-        ));
-
-        # Set up the block details.
-        $past.blocktype('method');
-        set_block_proto($past, 'Method');
-        my $signature;
-        if $<method_def><multisig> {
-            $signature := $( $<method_def><multisig>[0]<signature> );
-            set_block_sig($past, $signature);
-        }
-        else {
-            $signature := empty_signature();
-            set_block_sig($past, $signature);
+            );
         }
-        $past := add_method_to_class($past);
 
-        # If the signature doesn't include an explicity invocant, add one to
-        # the signature.
-        my $found_invocant := 0;
-        if $signature[1].isa(PAST::Stmts) && $signature[1][1].isa(PAST::Stmts) {
-            for @($signature[1][1]) {
-                if $_[0].value() eq 'invocant' {
-                    $found_invocant := 1;
-                }
-            }
-        }
-        if !$found_invocant {
-            # Add anonymous parameter taking invocant.
-            my $descriptor := sig_descriptor_create();
-            sig_descriptor_set($descriptor, 'name', PAST::Val.new( :value('$') ));
-            sig_descriptor_set($descriptor, 'invocant', 1);
-            sig_descriptor_set($descriptor, 'multi_invocant', 1);
-            sig_descriptor_set($descriptor, 'constraints',
-                PAST::Op.new(
-                    :pasttype('call'),
-                    :name('list')
-                ));
-            my $obj := $signature.shift();
-            $signature.unshift($descriptor);
-            $signature.unshift($obj);
+        # Protos also need the proto property setting on them.
+        if $<sym> eq 'proto' {
+            $past.loadinit().push(
+                PAST::Op.new(:inline('    setprop block, "proto", %0'), 1)
+            );
         }
     }
-    elsif $key eq 'submethod' {
-        $/.panic('submethod declarations not yet implemented');
-    }
-    $past.node($/);
-    if (+@($past[1])) {
-        declare_implicit_routine_vars($past);
-    }
-    else {
-        $past[1].push( PAST::Op.new( :name('list') ) );
-    }
+
     make $past;
 }
 
@@ -905,8 +801,8 @@
 
         # Assemble all that we build into a statement list and then place it
         # into the init code.
-        our $?BLOCK;
-        my $loadinit := $?BLOCK.loadinit();
+        our @?BLOCK;
+        my $loadinit := @?BLOCK[0].loadinit();
         $loadinit.push($role_past);
         $loadinit.push($class_past);
 
@@ -925,473 +821,212 @@
 }
 
 
-method routine_def($/) {
-    my $past := $( $<block> );
-
-    if $<identifier> {
-        $past.name( ~$<identifier>[0] );
-        our $?BLOCK;
-        $?BLOCK.symbol(~$<identifier>[0], :scope('package'));
+method routine_declarator($/, $key) {
+    my $past;
+    if $key eq 'sub' {
+        $past := $($<routine_def>);
     }
-    $past.control('return_pir');
-
-    ##  process traits
-    ##  NOTE: much trait processing happens elsewhere at the moment
-    ##        so don't deal with errors until refactoring is complete
-    if $<trait> {
-        for $<trait> {
-            my $trait := $_;
-            if $trait<trait_auxiliary> {
-                my $aux  := $trait<trait_auxiliary>;
-                my $sym  := $aux<sym>;
-
-                if $sym eq 'is' {
-                    my $name := $aux<name>;
-
-                    ##  is export(...)
-                    if $name eq 'export' {
-                        if ! $<identifier> {
-                            $/.panic("use of 'is export(...)' trait"
-                                ~ " on anonymous Routines is not allowed");
-                        }
-
-                        my $loadinit := $past.loadinit();
-                        our $?NS;
-
-                        ##  create the export namespace(s)
-                        my $export_ns_base := ~$?NS ~ '::EXPORT::';
-                        my @export_ns;
-
-                        ##  every exported routine is bound to ::EXPORT::ALL
-                        @export_ns.push( $export_ns_base ~ 'ALL' );
-
-                        ##  get the names of the tagsets, if any, from the ast
-                        my $tagsets := $( $aux<postcircumfix>[0] );
-                        if $tagsets {
-                            my $tagsets_past := $tagsets;
-                            if  $tagsets_past.isa(PAST::Op)
-                                    && $tagsets_past.pasttype() eq 'call' {
-                                for @( $tagsets_past ) {
-                                    unless $_.isa(PAST::Val)
-                                            && $_.named() {
-                                        $/.panic('unknown argument "' ~ $_
-                                            ~ '" in "is export()" trait' );
-                                    }
-
-                                    my $tag := $_<named><value>;
-                                    if $tag ne 'ALL' {
-                                        @export_ns.push(
-                                            $export_ns_base ~ $tag
-                                        );
-                                    }
-                                }
-                            }
-                        }
-
-                        ##  bind the routine to the export namespace(s)
-                        for @export_ns {
-                            $loadinit.push(
-                                PAST::Op.new(
-                                    :pasttype('bind'),
-                                    PAST::Var.new(
-                                        :name( $past.name() ),
-                                        :namespace(
-                                            Perl6::Compiler.parse_name( $_ )
-                                        ),
-                                        :scope('package'),
-                                        :isdecl(1)
-                                    ),
-                                    PAST::Var.new(
-                                        :name('block'), :scope('register')
-                                    )
-                                )
-                            );
-                        }
-                    }
-                    else {
-                        # Trait not handled in the compiler; emit call to apply it.
-                        my @ns := Perl6::Compiler.parse_name( $name );
-                        $past.loadinit().push(
-                            PAST::Op.new(
-                                :pasttype('call'),
-                                :name('trait_auxiliary:is'),
-                                PAST::Var.new(
-                                    :name(@ns.pop()),
-                                    :namespace(@ns),
-                                    :scope('package')
-                                ),
-                                PAST::Var.new(
-                                    :name('block'), :scope('register')
-                                )
-                            )
-                        );
-                    }
-                }
-            }
-        }
+    elsif $key eq 'method' {
+        $past := $($<method_def>);
     }
-
+    elsif $key eq 'submethod' {
+        $/.panic('submethod declarations not yet implemented');
+    }
+    $past.node($/);
+    if (+@($past[1])) {
+        declare_implicit_routine_vars($past);
+    }
+    else {
+        $past[1].push( PAST::Op.new( :name('list') ) );
+    }
+    ##  Add a call to !SIGNATURE_BIND to fixup params and do typechecks.
+    $past[0].push(
+        PAST::Op.new( :pasttype('call'), :name('!SIGNATURE_BIND') )
+    );
     make $past;
 }
 
-method method_def($/) {
+
+method routine_def($/) {
     my $past := $( $<block> );
-    my $identifier := $<identifier>;
-    if $identifier {
-        $past.name( ~$identifier[0] );
+    $past.blocktype('declaration');
+    if $<deflongname> {
+        my $name := ~$<deflongname>[0];
+        $past.name( $name );
+        our @?BLOCK;
+        @?BLOCK[0].symbol( $name, :scope('package') );
     }
     $past.control('return_pir');
-
-    # Emit code to apply any traits.
-    if $<trait> {
-        for $<trait> {
-            my $trait := $_;
-            if $trait<trait_auxiliary> {
-                my $aux  := $trait<trait_auxiliary>;
-                my $sym  := $aux<sym>;
-
-                if $sym eq 'is' {
-                    my $name := $aux<name>;
-
-                    # Emit call to trait_auxiliary:is apply trait.
-                    my @ns := Perl6::Compiler.parse_name( $name );
-                    $past.loadinit().push(
-                        PAST::Op.new(
-                            :pasttype('call'),
-                            :name('trait_auxiliary:is'),
-                            PAST::Var.new(
-                                :name(@ns.pop()),
-                                :namespace(@ns),
-                                :scope('package')
-                            ),
-                            PAST::Var.new(
-                                :name('block'), :scope('register')
-                            )
-                        )
-                    );
-                }
-            }
-        }
-    }
-
+    create_signature_if_none($past);
     make $past;
 }
 
 
-method signature($/) {
-    # In here, we build a signature object and optionally some other things
-    # if $?SIG_BLOCK_NOT_NEEDED is not set to a true value.
-    # * $?BLOCK_SIGNATURED ends up containing the PAST tree for a block that
-    #   takes and binds the parameters. This is used for generating subs,
-    #   methods and so forth.
-
-    # Initialize PAST for the signatured block, if we're going to have it.
-    our $?SIG_BLOCK_NOT_NEEDED;
-    my $params;
-    my $type_check;
-    my $block_past;
-    unless $?SIG_BLOCK_NOT_NEEDED {
-        $params := PAST::Stmts.new( :node($/) );
-        $block_past := PAST::Block.new( $params, :blocktype('declaration') );
-        $type_check := PAST::Stmts.new( :node($/) );
-    }
-
-    # Initialize PAST for constructing the signature object.
-    my $sig_past := PAST::Op.new(
-        :pasttype('callmethod'),
-        :name('!create'),
-        PAST::Var.new(
-            :name('Signature'),
-            :scope('package'),
-            :namespace(list())
-        )
-    );
+method method_def($/) {
+    my $past := $( $<block> );
+    $past.blocktype('method');
 
-    # Go through the parameters.
-    my $is_multi_invocant := 1;
-    for $/[0] {
-        my $parameter := $($_<parameter>);
-        my $separator := $_[0];
-        my $is_invocant := 0;
-
-        # If it has & sigil, strip it off, but record it was a sub.
-        my $is_callable := 0;
-        if substr($parameter.name(), 0, 1) eq '&' {
-            $parameter.name(substr($parameter.name(), 1));
-            $is_callable := 1;
-        }
-
-        # Add parameter declaration to the block, if we're producing one.
-        unless $?SIG_BLOCK_NOT_NEEDED {
-            # Register symbol and put parameter PAST into the node.
-            $block_past.symbol($parameter.name(), :scope('lexical'));
-            $params.push($parameter);
-
-            # If it is invocant, modify it to be just a lexical and bind self to it.
-            if substr($separator, 0, 1) eq ':' {
-                $is_invocant := 1;
-
-                # Make sure it's first parameter.
-                if +@($params) != 1 {
-                    $/.panic("There can only be one invocant and it must be the first parameter");
-                }
+    if $<longname> {
+        $past.name( ~$<longname> );
+    }
 
-                # Modify.
-                $parameter.scope('lexical');
-                $parameter.isdecl(1);
-
-                # Bind self to it.
-                $params.push(PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name($parameter.name()),
-                        :scope('lexical')
-                    ),
-                    PAST::Var.new( :name('self'), :scope('register') )
-                ));
-            }
-        }
+    # Add lexical 'self'.
+    $past[0].unshift(
+        PAST::Var.new( :name('self'), :scope('lexical'), :isdecl(1),
+            :viviself( PAST::Var.new( :name('self'), :scope('register' ) ) )
+        )
+    );
 
-        # Now start making a descriptor for the signature.
-        my $descriptor := sig_descriptor_create();
-        $sig_past.push($descriptor);
-        sig_descriptor_set($descriptor, 'name',
-            PAST::Val.new( :value(~$parameter.name()) ));
-        if $parameter.named() {
-            sig_descriptor_set($descriptor, 'named',
-                PAST::Val.new( :value(~$parameter.named()) ));
-        }
-        if $parameter.viviself() {
-            sig_descriptor_set($descriptor, 'optional', 1);
-        }
-        if $parameter.slurpy() {
-            sig_descriptor_set($descriptor, 'slurpy', 1);
-        }
-        if $is_invocant {
-            sig_descriptor_set($descriptor, 'invocant', 1);
-        }
-        if $is_multi_invocant {
-            sig_descriptor_set($descriptor, 'multi_invocant', 1);
-        }
-
-        # See if we have any traits. For now, we just handle ro, rw and copy.
-        my $cont_trait := 'readonly';
-        my $cont_traits := 0;
-        for $_<parameter><trait> {
-            if $_<trait_auxiliary> {
-                # Get name of the trait and see if it's one of the special
-                # traits we handle in the compiler.
-                my $name := ~$_<trait_auxiliary><name>;
-                if $name eq 'readonly' {
-                    $cont_traits := $cont_traits + 1;
-                }
-                elsif $name eq 'rw' {
-                    $cont_trait := 'rw';
-                    $cont_traits := $cont_traits + 1;
-                }
-                elsif $name eq 'copy' {
-                    $cont_trait := 'copy';
-                    $cont_traits := $cont_traits + 1;
-                }
-                else {
-                    $/.panic("Cannot apply trait " ~ $name ~ " to parameters yet.");
-                }
-            }
-            else {
-                $/.panic("Cannot apply traits to parameters yet.");
-            }
-        }
+    $past.control('return_pir');
+    create_signature_if_none($past);
+    make $past;
+}
 
-        # If we had is copy is rw or some other impossible combination, die.
-        if $cont_traits > 1 {
-            $/.panic("Can only use one of readonly, rw and copy on a parameter.");
-        }
-
-        # Add any type check that is needed. The scheme for this: $type_check
-        # is a statement block. We create a block for each parameter, which
-        # will be empty if there are no constraints for that parameter. This
-        # is so we can later generate a multi-sig from it.
-        my $cur_param_types := PAST::Stmts.new();
-        if $_<parameter><type_constraint> {
-            for $_<parameter><type_constraint> {
-                # Just a type name?
-                if $_<typename><name><identifier> {
-                    # Get type; we may have to fix up the scope if it's
-                    # been captured within the signature.
-                    my $type := $( $_<typename> );
-                    my $local_sym := $block_past.symbol($type.name());
-                    if $local_sym {
-                        $type.scope($local_sym<scope>);
-                    }
 
-                    # Emit check.
-                    my $type_obj := PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!TYPECHECKPARAM'),
-                        $type,
-                        PAST::Var.new(
-                            :name($parameter.name()),
-                            :scope('lexical')
-                        )
-                    );
-                    $cur_param_types.push($type_obj);
-                }
-                # is it a ::Foo type binding?
-                elsif $_<typename> {
-                    my $tvname := ~$_<typename><name><morename>[0]<identifier>;
-                    $params.push(PAST::Op.new(
-                        :pasttype('bind'),
-                        PAST::Var.new( :name($tvname), :scope('lexical'), :isdecl(1)),
-                        PAST::Op.new(
-                            :pasttype('callmethod'),
-                            :name('WHAT'),
-                            PAST::Var.new(
-                                :name($parameter.name()),
-                                :scope('lexical')
-                            )
-                        )
-                    ));
-                    $block_past.symbol($tvname, :scope('lexical'));
-                }
-                else {
-                    my $type_obj := make_anon_subset($( $_<EXPR> ), $parameter);
-                    $cur_param_types.push($type_obj);
-                }
-            }
-        }
+method trait($/) {
+    my $past;
+    if $<trait_auxiliary> {
+        $past := $( $<trait_auxiliary> );
+    }
+    elsif $<trait_verb> {
+        $past := $( $<trait_verb> );
+    }
+    make $past;
+}
 
-        # Add any post-constraints too.
-        for $_<parameter><post_constraint> {
-            my $type_obj := make_anon_subset($( $_<EXPR> ), $parameter);
-            $cur_param_types.push($type_obj);
-        }
+method trait_auxiliary($/) {
+    my $sym := ~$<sym>;
+    my $trait;
+    if $sym eq 'is' || $sym eq 'does' {
+        $trait := ~$<name>;
+    }
+    make PAST::Op.new( :name('infix:,'), 'trait_auxiliary:' ~ $sym, $trait );
+}
 
-        # Also any constraint from the sigil.
-        if $is_callable {
-            $cur_param_types.push(PAST::Op.new(
-                :pasttype('call'),
-                :name('!TYPECHECKPARAM'),
-                PAST::Var.new( :name('Callable'), :scope('package') ),
-                PAST::Var.new(
-                    :name($parameter.name()),
-                    :scope('lexical')
-                )
-            ));
-        }
 
-        # For blocks, we just collect the check into the list of all checks.
-        unless $?SIG_BLOCK_NOT_NEEDED {
-            $type_check.push($cur_param_types);
-        }
+method trait_verb($/) {
+    my $sym := ~$<sym>;
+    my $value;
+    if $sym eq 'handles' { $value := $( $<EXPR> ); }
+    else { $value := $( $<typename> ); }
+    make PAST::Op.new( :name('infix:,'), 'trait_verb:' ~ $sym, $value );
+}
 
-        # For signatures, we build a list from the constraints and store it.
-        my $sig_type_cons := PAST::Stmts.new(
-            PAST::Op.new(
-                :inline('    $P2 = new "List"')
-            ),
-            PAST::Stmts.new(),
-            PAST::Op.new(
-                :inline('    %r = $P2')
-            )
-        );
-        for @($cur_param_types) {
-            # Just want the type, not the call to the checker.
-            $sig_type_cons[1].push(PAST::Op.new(
-                :inline('    push $P2, %0'),
-                $_[0]
-            ));
-        }
-        sig_descriptor_set($descriptor, 'constraints', $sig_type_cons);
 
-        # If we're making a block, emit code for trait types.
-        unless $?SIG_BLOCK_NOT_NEEDED {
-            if $cont_trait eq 'rw' {
-                # We just leave it as it is.
-            }
-            elsif $cont_trait eq 'readonly' {
-                # Create a new container with ro set and bind the parameter to it.
-                $params.push(PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name($parameter.name()),
-                        :scope('lexical')
-                    ),
-                    PAST::Op.new(
-                        :inline(
-                            '    %r = new "Perl6Scalar", %0',
-                            '    $P0 = get_hll_global ["Bool"], "True"',
-                            '    setprop %r, "readonly", $P0'
-                        ),
-                        PAST::Var.new(
-                            :name($parameter.name()),
-                            :scope('lexical')
-                        )
-                    )
-                ));
+method signature($/, $key) {
+    our @?BLOCK;
+    if $key eq 'open' {
+        my $sigpast := PAST::Op.new( :pasttype('stmts'), :node($/) );
+        my $block    := PAST::Block.new( $sigpast, :blocktype('declaration') );
+        $block<signature> := 1;
+        $block<explicit_signature> := 1;
+        @?BLOCK.unshift($block);
+    }
+    else {
+        my $block    := @?BLOCK.shift();
+        my $sigpast := $block[0];
+        my $loadinit := $block.loadinit();
+        my $sigobj   := PAST::Var.new( :scope('register') );
+
+        ##  create a Signature object and attach to the block
+        $loadinit.push(
+            PAST::Op.new( :inline('    %0 = new "Signature"',
+                                  '    setprop block, "$!signature", %0'),
+                           $sigobj)
+        );
+
+        ##  loop through parameters of signature
+        my $arity := $<parameter> ?? +@($<parameter>) !! 0;
+        $block.arity($arity);
+        my $i                  := 0;
+        my $multi_inv_suppress := 0;
+        while $i < $arity {
+            my $var    := $( $<parameter>[$i] );
+            my $name   := $var.name();
+
+            ##  add var node to block
+            $sigpast.push( $var );
+
+            if $var<type_binding> {
+                $sigpast.push( $var<type_binding> );
+            }
+
+            ##  add parameter to the signature object
+            my $sigparam := PAST::Op.new( :pasttype('callmethod'),
+                                :name('!add_param'), $sigobj, $name );
+
+            ##  add any typechecks
+            my $type := $var<type>;
+            if +@($type) > 0 {
+                ##  don't need the 'and' junction for only one type
+                if +@($type) == 1 { $type := $type[0] }
+                $type.named('type');
+                $sigparam.push($type);
+            }
+
+            ##  add traits (we're not using this yet.)
+            my $trait := $var<trait>;
+            if $trait {
+                $trait.named('trait');
+                $sigparam.push($trait);
+            }
+
+            my $readtype := trait_readtype( $var<traitlist> ) || 'readonly';
+            if $readtype eq 'CONFLICT' {
+                $<parameter>[$i].panic(
+                    "Can use only one of readonly, rw, and copy on "
+                    ~ $name ~ " parameter"
+                );
             }
-            elsif $cont_trait eq 'copy' {
-                # Create a new container and copy the value into it..
-                $params.push(PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                    :name($parameter.name()),
-                    :scope('lexical')
-                    ),
-                    PAST::Op.new(
-                        :inline(
-                            '    %r = new "Perl6Scalar"',
-                            '    "!COPYPARAM"(%r, %0)'
-                        ),
-                        PAST::Var.new(
-                            :name($parameter.name()),
-                            :scope('lexical')
-                        )
-                    )
-                ));
+            $sigparam.push(PAST::Val.new(:value($readtype),:named('readtype')));
+
+            if ($multi_inv_suppress) {
+                $sigparam.push(PAST::Val.new(:value(0),:named('multi_invocant')));
             }
-        }
+            if $<param_sep>[$i][0] eq ';;' { $multi_inv_suppress := 1; }
 
-        # If the separator is a ;; then parameters beyond this are not multi
-        # invocants.
-        if substr($separator, 0, 2) eq ';;' {
-            $is_multi_invocant := 0;
+            $loadinit.push($sigparam);
+            $i++;
         }
-    }
 
-    # Finish setting up the signatured block, if we're making one.
-    unless $?SIG_BLOCK_NOT_NEEDED {
-        $block_past.arity( +$/[0] );
-        our $?BLOCK_SIGNATURED := $block_past;
-        $params.push($type_check);
+        ##  restore block stack and return signature ast
+        our $?BLOCK_OPEN;
+        $?BLOCK_OPEN := $block;
+        make $sigpast;
     }
+}
 
-    # Hand back the PAST to construct a signature object.
-    make $sig_past;
+
+method type_constraint($/) {
+    my $past;
+    if $<fulltypename> {
+        $past := $( $<fulltypename> );
+    }
+    make $past;
 }
 
 
 method parameter($/) {
-    my $past := $( $<param_var> );
+    my $var   := $( $<param_var> );
     my $sigil := $<param_var><sigil>;
     my $quant := $<quant>;
 
+    ##  handle slurpy and optional flags
     if $quant eq '*' {
-        $past.slurpy( $sigil eq '@' || $sigil eq '%' );
-        $past.named( $sigil eq '%' );
+        $var.slurpy( $sigil eq '@' || $sigil eq '%' );
+        $var.named( $sigil eq '%' );
     }
-    else {
-        if $<named> eq ':' {          # named
-            $past.named(~$<param_var><identifier>);
-            if $quant ne '!' {      #  required (optional is default)
-                $past.viviself('Failure');
-            }
-        }
-        else {                        # positional
-            if $quant eq '?' {      #  optional (required is default)
-                $past.viviself('Failure');
-            }
+    elsif $<named> eq ':' {          # named
+        $var.named(~$<param_var><identifier>);
+        if $quant ne '!' {      #  required (optional is default)
+            $var.viviself('Nil');
         }
     }
+    elsif $quant eq '?' {           # positional optional
+        $var.viviself('Nil');
+    }
+
+    ##  handle any default value
     if $<default_value> {
         if $quant eq '!' {
             $/.panic("Can't put a default on a required parameter");
@@ -1399,27 +1034,63 @@
         if $quant eq '*' {
             $/.panic("Can't put a default on a slurpy parameter");
         }
-        $past.viviself( $( $<default_value>[0]<EXPR> ) );
+        $var.viviself( $( $<default_value>[0]<EXPR> ) );
     }
-    make $past;
+
+    ##  keep track of any type constraints
+    my $typelist := PAST::Op.new( :name('and'), :pasttype('call') );
+    $var<type> := $typelist;
+    if $<type_constraint> {
+        for @($<type_constraint>) {
+            my $type_past := $( $_ );
+            if substr( $_.text() , 0, 2 ) eq '::' {
+                # it's a type binding
+                $type_past.scope('lexical');
+                $type_past.isdecl(1);
+                $type_past.viviself(
+                    PAST::Op.new( :pasttype('callmethod'), :name('WHAT'),
+                        PAST::Var.new( :name($var.name()) )
+                    )
+                );
+                $var<type_binding> := $type_past;
+                our @?BLOCK;
+                @?BLOCK[0].symbol( $type_past.name(), :scope('lexical') );
+            }
+            else {
+                $typelist.push( $type_past );
+            }
+        }
+    }
+
+    if $<trait> {
+        my $traitlist := PAST::Op.new( :name('infix:,'), :pasttype('call') );
+        $var<traitlist> := $traitlist;
+        for @($<trait>) { $traitlist.push( $( $_ ) ); }
+    }
+
+    make $var;
 }
 
 
 method param_var($/) {
-    my $twigil := $<twigil>;
-    if $twigil && $twigil[0] ne '.' && $twigil[0] ne '!' {
+    my $name := ~$/;
+    my $twigil := ~$<twigil>[0];
+    if $twigil && $twigil ne '.' && $twigil ne '!' {
         $/.panic('Invalid twigil used in signature parameter.');
     }
-    make PAST::Var.new(
-        :name(~$/),
+    my $var := PAST::Var.new(
+        :name($name),
         :scope('parameter'),
         :node($/)
     );
-}
-
+    $var<itype> := container_itype( $<sigil> );
+    # Declare symbol as lexical in current (signature) block.
+    # This is needed in case any post_constraints try to reference
+    # this new param_var.
+    our @?BLOCK;
+    @?BLOCK[0].symbol( $name, :scope('lexical') );
 
-method special_variable($/) {
-    make PAST::Var.new( :node($/), :name(~$/), :scope('lexical') );
+    make $var;
 }
 
 
@@ -1673,938 +1344,375 @@
 
 
 method package_declarator($/, $key) {
-    our $?CLASS;
-    our @?CLASS;
-    our $?GRAMMAR;
-    our @?GRAMMAR;
-    our $?MODULE;
-    our @?MODULE;
-    our $?PACKAGE;
-    our @?PACKAGE;
-    our $?ROLE;
-    our @?ROLE;
-
-    my $sym := $<sym>;
-
+    our @?PKGDECL;
+    my $sym := ~$<sym>;
+    my $past;
     if $key eq 'open' {
-        # Start of a new package. We create an empty PAST::Stmts node for the
-        # package definition to be stored in and put it onto the current stack
-        # of packages and the stack of its package type.
-        my $decl_past := PAST::Stmts.new();
-
-        if    $sym eq 'package' {
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  module isa package
-        elsif $sym eq 'module' {
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  role isa module isa package
-        elsif $sym eq 'role' {
-            @?ROLE.unshift($decl_past);
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  class isa module isa package
-        elsif $sym eq 'class' {
-            @?CLASS.unshift($decl_past);
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  grammar isa class isa module isa package
-        elsif $sym eq 'grammar' {
-            @?GRAMMAR.unshift($decl_past);
-            @?CLASS.unshift($decl_past);
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
+        our $?BLOCK_OPEN;
+        $?BLOCK_OPEN := PAST::Block.new( PAST::Stmts.new(), :node($/) );
+        $?BLOCK_OPEN<pkgdecl> := $sym;
+        @?PKGDECL.unshift( $sym );
     }
     else {
-        # End of declaration. Our PAST will be that made by the package_def or
-        # role_def.
-        my $past := $( $/{$key} );
-
-        # Set $?PACKAGE at the start of it.
-        $past.unshift(set_package_magical());
-
-        # Restore outer values in @?<magical> arrays
-        if    $sym eq 'package' {
-            @?PACKAGE.shift();
-        }
-        ##  module isa package
-        elsif $sym eq 'module' {
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        ##  role isa module isa package
-        elsif $sym eq 'role' {
-            @?ROLE.shift();
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        ##  class isa module isa package
-        elsif $sym eq 'class' {
-            @?CLASS.shift();
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        ##  grammar isa class isa module isa package
-        elsif $sym eq 'grammar' {
-            @?GRAMMAR.shift();
-            @?CLASS.shift();
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        make $past;
+        make $( $<package_def> );
+        @?PKGDECL.shift();
     }
-
-    # make sure @?<magical>[0] is always the same as $?<magical>
-    $?CLASS   := @?CLASS[0];
-    $?GRAMMAR := @?GRAMMAR[0];
-    $?MODULE  := @?MODULE[0];
-    $?PACKAGE := @?PACKAGE[0];
-    $?ROLE    := @?ROLE[0];
 }
 
 
 method package_def($/, $key) {
-    our $?CLASS;
-    our $?GRAMMAR;
-    our $?MODULE;
-    our $?NS;
-    our $?PACKAGE;
-    my $name := $<name>;
-
-    if $key eq 'open' {
-        # Start of package definition. Handle class and grammar specially.
-        if $?PACKAGE =:= $?GRAMMAR {
-            # Anonymous grammars not supported.
-            unless $name {
-                $/.panic('Anonymous grammars not supported');
-            }
-
-            # Start of grammar definition. Create grammar class object.
-            $?GRAMMAR.push(
-                PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ),
-                    PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!keyword_grammar'),
-                        PAST::Val.new( :value(~$name[0]) )
-                    )
-                )
-            );
-        }
-        elsif $?PACKAGE =:= $?CLASS {
-            my $class_def;
+    our @?PKGDECL;
+    my $?PKGDECL := @?PKGDECL[0];
 
-            if !have_trait('also', 'is', $<trait>) {
-                # Start of class definition; make PAST to create class object if
-                # we're creating a new class.
-                $class_def := PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ),
-                    PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!keyword_class')
-                    )
-                );
-
-                # Add a name, if we have one.
-                if $name {
-                    $class_def[1].push( PAST::Val.new( :value(~$name[0]) ) );
-                }
-            }
-            else {
-                # We're adding to an existing class. Look up class by name and put
-                # it in $def.
-                unless $<name> {
-                    $/.panic("Can only use is also trait on a named class.");
-                }
-                my @namespace := Perl6::Compiler.parse_name($<name>[0]);
-                my $short_name := @namespace.pop();
-                $class_def := PAST::Op.new(
-                    :node($/),
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ),
-                    PAST::Op.new(
-                        :pasttype('callmethod'),
-                        :name('get_parrotclass'),
-                        PAST::Var.new(
-                            :scope('package'),
-                            :name('$!P6META'),
-                            :namespace('Perl6Object')
-                        ),
-                        PAST::Var.new(
-                            :name($short_name),
-                            :namespace(@namespace),
-                            :scope('package')
-                        )
-                    )
-                );
-            }
-
-            $?CLASS.push($class_def);
-        }
-        else {
-            # Anonymous modules not supported.
-            unless $name {
-                $/.panic('Anonymous modules not supported');
-            }
-        }
-
-        # Also store the current namespace, if we're not anonymous.
-        if $name {
-            $?NS := ~$name[0];
-        }
+    if $key eq 'panic' {
+        $/.panic("Unable to parse " ~ $?PKGDECL ~ " definition");
     }
-    else {
-        # XXX For now, to work around the :load :init not being allowed to be
-        # an outer bug, we will enclose the actual package block inside an
-        # immediate block of its own.
-        my $inner_block := $( $<package_block> );
-        $inner_block.blocktype('immediate');
-        my $past := PAST::Block.new(
-            $inner_block
-        );
-
-        # Declare the namespace and that the result block holds things that we
-        # do "on load".
-        if $name {
-            $past.namespace(Perl6::Compiler.parse_name($<name>[0]));
-        }
-        $past.blocktype('declaration');
-        $past.pirflags(':init :load');
-
-        if $?PACKAGE =:= $?GRAMMAR {
-            # Apply traits.
-            apply_package_traits($?GRAMMAR, $<trait>);
-
-            # Make proto-object for grammar.
-            $?GRAMMAR.push(
-                PAST::Op.new(
-                    :pasttype('call'),
-                    :name('!PROTOINIT'),
-                    PAST::Op.new(
-                        :pasttype('callmethod'),
-                        :name('register'),
-                        PAST::Var.new(
-                            :scope('package'),
-                            :name('$!P6META'),
-                            :namespace('Perl6Object')
-                        ),
-                        PAST::Var.new(
-                            :scope('register'),
-                            :name('def')
-                        ),
-                        PAST::Val.new(
-                            :value('Grammar'),
-                            :named( PAST::Val.new( :value('parent') ) )
-                        )
-                    )
-                )
-            );
-
-            # Attatch grammar declaration to the init code.
-            our $?BLOCK;
-            $?BLOCK.loadinit().push( $?GRAMMAR );
-
-            # Clear namespace.
-            $?NS := '';
-        }
-        elsif $?PACKAGE =:= $?CLASS {
-            # Apply traits.
-            apply_package_traits($?CLASS, $<trait>);
-
-            # Check if we have the is also trait - don't re-create
-            # proto-object if so.
-            if !have_trait('also', 'is', $<trait>) {
-                # It's a new class definition. Make proto-object.
-                $?CLASS.push(
-                    PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!PROTOINIT'),
-                        PAST::Op.new(
-                            :pasttype('callmethod'),
-                            :name('register'),
-                            PAST::Var.new(
-                                :scope('package'),
-                                :name('$!P6META'),
-                                :namespace('Perl6Object')
-                            ),
-                            PAST::Var.new(
-                                :scope('register'),
-                                :name('def')
-                            ),
-                            PAST::Val.new(
-                                :value('Any'),
-                                :named( PAST::Val.new( :value('parent') ) )
-                            )
-                        )
-                    )
-                );
-
-                # If this is an anonymous class, the block doesn't want to be a
-                # :init :load, and it's going to contain the class definition, so
-                # we need to declare the lexical $def.
-                unless $name {
-                    $past.pirflags('');
-                    $past.blocktype('immediate');
-                    $past[0].push(PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ));
-                }
-            }
 
-            # Attatch any class initialization code to the init code;
-            # note that we skip blocks, which are method accessors that
-            # we want to put under this block so they get the correct
-            # namespace. If it's an anonymous class, everything goes into
-            # this block.
-            for @( $?CLASS ) {
-                if $_.isa(PAST::Block) || !$name {
-                    $past[0].push( $_ );
-                }
-                else {
-                    our $?BLOCK;
-                    $?BLOCK.loadinit().push( $_ );
-                }
-            }
-        }
+    my $block := $( $/{$key} );
+    $block.blocktype('declaration');
+    $block.lexical(0);
 
-        make $past;
+    my $modulename := $<module_name>
+                         ?? ~$<module_name>[0] !!
+                         $block.unique('!ANON');
+    if ($modulename) {
+        $block.namespace( PAST::Compiler.parse_name( $modulename ) );
     }
-}
 
-
-method role_def($/, $key) {
-    our $?ROLE;
-    our $?NS;
-    my $name := ~$<name>;
-
-    if $key eq 'open' {
-        # Start of role definition. Push on code to create a role object.
-        $?ROLE.push(
-            PAST::Op.new(
-                :pasttype('bind'),
-                PAST::Var.new(
-                    :name('def'),
-                    :scope('register'),
-                    :isdecl(1)
-                ),
-                PAST::Op.new(
-                    :pasttype('call'),
-                    :name('!keyword_role'),
-                    PAST::Val.new( :value($name) )
-                )
-            )
-        );
-
-        # Also store the current namespace.
-        $?NS := $name;
+    if $key eq 'block' {
+        # A normal block acts like a BEGIN and is executed ASAP.
+        $block.pirflags(':load :init');
     }
-    else {
-        # Declare the namespace and that the result block holds things that we
-        # do "on load".
-        my $past := $( $<package_block> );
-        $past.namespace( PAST::Compiler.parse_name($name) );
-        $past.blocktype('declaration');
-        $past.pirflags(':init :load');
-
-        # Apply traits.
-        apply_package_traits($?ROLE, $<trait>);
-
-        # Attatch role declaration to the init code, skipping blocks since
-        # those are accessors.
-        for @( $?ROLE ) {
-            if $_.isa(PAST::Block) {
-                $past.push( $_ );
-            }
-            else {
-                our $?BLOCK;
-                $?BLOCK.loadinit().push( $_ );
-            }
-        }
-
-        # Clear namespace.
-        $?NS := '';
-
-        make $past;
+    elsif $key eq 'statement_block' && !$<module_name> {
+        $/.panic("Compilation unit cannot be anonymous");
     }
-}
 
+    #  Create a node at the beginning of the block's initializer
+    #  for package initializations
+    my $init := PAST::Stmts.new();
+    $block[0].unshift( $init );
 
-method package_block($/, $key) {
-    my $past := $( $/{$key} );
-    make $past;
-}
-
+    #  Normally we would create the metaclass object first,
+    #  but if there's an "is also" trait we want to do a class
+    #  lookup instead.  So we do the trait processing first
+    #  (scanning for 'is also' as we go), and then decide how
+    #  to obtain the metaclass.
 
-method variable_declarator($/) {
-    my $past := $( $<variable> );
-
-    # If it's an attribute declaration, we handle traits elsewhere.
-    my $twigil := $<variable><twigil>[0];
-    if $<trait> && $twigil ne '.' && $twigil ne '!' {
-        for $<trait> {
-            my $trait := $_;
-            if $trait<trait_auxiliary> {
-                my $aux := $trait<trait_auxiliary>;
-                my $sym := $aux<sym>;
-                if $sym eq 'is' {
-                    if $aux<postcircumfix> {
-                        $/.panic("'" ~ ~$trait ~ "' not implemented");
-                    }
-                    else {
-                        $past.viviself(~$aux<name>);
-                    }
-                }
-                else {
-                    $/.panic("'" ~ $sym ~ "' not implemented");
-                }
-            }
-            elsif $trait<trait_verb> {
-                my $verb := $trait<trait_verb>;
-                my $sym := $verb<sym>;
-                if $sym ne 'handles' {
-                    $/.panic("'" ~ $sym ~ "' not implemented");
-                }
-            }
-        }
-    }
-
-    make $past;
-}
-
-
-method scoped($/) {
-    my $past;
-
-    # Variable declaration?
-    if $<declarator><variable_declarator> {
-        $past := $( $<declarator><variable_declarator> );
-
-        # Unless it's an attribute, emit code to set type and initialize it to
-        # the correct proto.
-        if $<fulltypename> && $past.isa(PAST::Var) {
-            my $type_pir := "    %r = new %0, %1\n    setprop %r, 'type', %2\n";
-            my $type := build_type($<fulltypename>);
-            $past.viviself(
-                PAST::Op.new(
-                    :inline($type_pir),
-                    PAST::Val.new( :value(~$past.viviself()) ),
-                    PAST::Op.new(
-                        :pasttype('if'),
-                        PAST::Op.new(
-                            :pirop('isa'),
-                            $type,
-                            PAST::Val.new( :value("P6protoobject") )
-                        ),
-                        $type,
-                        PAST::Var.new(
-                            :name('Failure'),
-                            :scope('package')
-                        )
-                    ),
-                    $type
-                )
-            );
-        }
-    }
-
-    # Variable declaration, but with a signature?
-    elsif $<declarator><signature> {
-        if $<fulltypename> {
-            $/.panic("Distributing a type across a signature at declaration unimplemented.");
-        }
-        $past := $( $<declarator><signature> );
-    }
-
-    # Routine declaration?
-    else {
-        $past := $( $<routine_declarator> );
-
-        # Don't support setting return type yet.
-        if $<fulltypename> {
-            $/.panic("Setting return type of a routine not yet implemented.");
-        }
-    }
-    make $past;
-}
-
-
-sub declare_attribute($/, $sym, $variable_sigil, $variable_twigil, $variable_name) {
-    # Get the class or role we're in.
-    our $?CLASS;
-    our $?ROLE;
-    our $?PACKAGE;
-    our $?BLOCK;
-    my $class_def;
-    if $?ROLE =:= $?PACKAGE {
-        $class_def := $?ROLE;
-    }
-    else {
-        $class_def := $?CLASS;
-    }
-    unless defined( $class_def ) {
-        $/.panic(
-                "attempt to define attribute '" ~ $name ~ "' outside of class"
-        );
-    }
-
-    # Is this a role-private or just a normal attribute?
-    my $name;
-    if $sym eq 'my' {
-        # These are only allowed inside a role.
-        unless $class_def =:= $?ROLE {
-            $/.panic('Role private attributes can only be declared in a role');
-        }
-
-        # We need to name-manage this somehow. We'll do $!rolename!attrname
-        # for now; long term, want some UUID. For the block entry, we enter it
-        # as $!attrname, add the real name and set the scope as rpattribute,
-        # then translate it to the right thing when we see it.
-        our $?NS;
-        $name := ~$variable_sigil ~ '!' ~ $?NS ~ '!' ~ ~$variable_name;
-        my $visible_name := ~$variable_sigil ~ '!' ~ ~$variable_name;
-        my $real_name := '!' ~ $?NS ~ '!' ~ ~$variable_name;
-        $?BLOCK.symbol($visible_name, :scope('rpattribute'), :real_name($real_name));
-    }
-    else {
-        # Register name as attribute scope.
-        $name := ~$variable_sigil ~ '!' ~ ~$variable_name;
-        $?BLOCK.symbol($name, :scope('attribute'));
-    }
-
-    # Add attribute to class (always name it with ! twigil).
-    if $/<scoped><fulltypename> {
-        $class_def.push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!keyword_has'),
-                PAST::Var.new(
-                    :name('def'),
-                    :scope('register')
-                ),
-                PAST::Val.new( :value($name) ),
-                build_type($/<scoped><fulltypename>)
-            )
-        );
-    }
-    else {
-        $class_def.push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!keyword_has'),
-                PAST::Var.new(
-                    :name('def'),
-                    :scope('register')
-                ),
-                PAST::Val.new( :value($name) )
-            )
-        );
-    }
-
-    # Is there any "handles" trait verb or an "is rw" or "is ro"?
-    my $rw := 0;
-    if $<scoped><declarator><variable_declarator><trait> {
-        for $<scoped><declarator><variable_declarator><trait> {
-            if $_<trait_verb><sym> eq 'handles' {
-                # Get the methods for the handles and add them to
-                # the class
-                my $meths := process_handles(
-                    $/,
-                    $( $_<trait_verb><EXPR> ),
-                    $name
-                );
-                for @($meths) {
-                    $class_def.push($_);
-                }
-            }
-            elsif $_<trait_auxiliary><sym> eq 'is' {
-                # Just handle rw for now.
-                if ~$_<trait_auxiliary><name> eq 'rw' {
-                    $rw := 1;
-                }
-                else {
-                    $/.panic("Only 'is rw' trait is implemented for attributes");
-                }
-            }
+    #  Add any traits coming from the package declarator.
+    #  Traits in the body have already been added to the block.
+    our $?METACLASS;
+    if $<trait> {
+        for @($<trait>) {
+            #  Trait nodes come in as PAST::Op( :name('list') ).
+            #  We just modify them to call !meta_trait and add
+            #  the metaclass as the first argument.
+            my $trait := $( $_ );
+            if $trait[1] eq 'also' { $block<isalso> := 1; }
             else {
-                $/.panic("Only is and handles trait verbs are implemented for attributes");
+                $trait.name('!meta_trait');
+                $trait.unshift($?METACLASS);
+                $init.push($trait);
             }
         }
     }
 
-    # Generate private accessor.
-    my $accessor := make_accessor($/, '!' ~ ~$variable_name, $name, 1, 'attribute');
-    $class_def.push(add_method_to_class($accessor));
-
-    # Twigil handling.
-    if $variable_twigil eq '.' {
-        # We have a . twigil, so we need to generate a public accessor.
-        my $accessor := make_accessor($/, ~$variable_name, $name, $rw, 'attribute');
-        $class_def.push(add_method_to_class($accessor));
-    }
-    elsif $variable_twigil eq '!' {
-        # Don't need to do anything.
-    }
-    elsif $variable_twigil eq '' {
-        # We have no twigil, make $name as an alias to $!name.
-        $?BLOCK.symbol(
-            ~$variable_sigil ~ ~$variable_name, :scope('attribute')
-        );
-    }
-    else {
-        # It's a twigil that you canny use in an attribute declaration.
-        $/.panic(
-                "invalid twigil "
-            ~ $variable_twigil ~ " in attribute declaration"
-        );
-    }
-}
-
-method scope_declarator($/) {
-    our $?BLOCK;
-    my $declarator := $<sym>;
-    my $past := $( $<scoped> );
-
-    # What sort of thing are we scoping?
-    if $<scoped><declarator><variable_declarator> {
-        our $?PACKAGE;
-        our $?ROLE;
-        our $?CLASS;
-
-        # Variable. If it's declared with "has" it is always an attribute. If
-        # it is declared with "my" inside a role and has the ! twigil, it is
-        # a role private attribute.
-        my $variable := $<scoped><declarator><variable_declarator><variable>;
-        my $twigil := $variable<twigil>[0];
-        my $role_priv := $?ROLE =:= $?PACKAGE && $declarator eq 'my' && $twigil eq '!';
-        if $declarator eq 'has' || $role_priv {
-            # Attribute declarations need special handling.
-            my $sigil := ~$<scoped><declarator><variable_declarator><variable><sigil>;
-            my $twigil := ~$<scoped><declarator><variable_declarator><variable><twigil>[0];
-            my $name := ~$<scoped><declarator><variable_declarator><variable><name>;
-            declare_attribute($/, $declarator, $sigil, $twigil, $name);
-
-            # Always leave a PAST::Var attribute node behind (can't just use what was
-            # produced as . twigil may have transformed it to a method call).
-            $past := PAST::Var.new(
-                :node($<scoped><declarator><variable_declarator><variable>),
-                :name($name),
-                :scope('attribute'),
-                :isdecl(1)
-            );
-        }
-
-        # If we're in a class and have something declared with a sigil, then
-        # we need to generate an accessor method and emit that along with the
-        # lexical declaration itself.
-        elsif ($twigil eq '.' || $twigil eq '!') && $?CLASS =:= $?PACKAGE {
-            # This node is just the variable declaration; also register it in
-            # the symbol table.
-            my $orig_past := $past;
-            $past := PAST::Var.new(
-                :name(~$variable<sigil> ~ '!' ~ ~$variable<name>),
-                :scope('lexical'),
-                :isdecl(1),
-                :viviself(container_type(~$variable<sigil>))
-            );
-            $?BLOCK.symbol($past.name(), :scope('lexical'));
-
-            # Now generate accessor, if it's public.
-            if $twigil eq '.' {
-                $?CLASS.push(make_accessor($/, $orig_past.name(), $past.name(), 1, 'lexical'));
-            }
-        }
-
-        # Otherwise, just a normal variable declaration.
-        else {
-            # Has this already been declared?
-            my $name := $past.name();
-            unless $?BLOCK.symbol($name) {
-                #  First declaration
-                my $scope := 'lexical';
-                $past.isdecl(1);
-                if $declarator eq 'our' {
-                    $scope := 'package';
-                }
-                elsif $declarator ne 'my' {
-                    $/.panic(
-                          "scope declarator '"
-                        ~ $declarator ~ "' not implemented"
-                    );
-                }
+    #  At the beginning, create the "class/module/grammar/role/etc"
+    #  metaclass handle on which we do the other operations.
+    $init.unshift(
+        PAST::Op.new( :pasttype('bind'),
+            PAST::Var.new(:name('metaclass'), :scope('register'), :isdecl(1) ),
+            PAST::Op.new(:name('!meta_create'),
+                $?PKGDECL, $modulename, +$block<isalso>
+            )
+        )
+    );
 
-                # Add block entry and set scope.
-                $past.scope($scope);
-                $?BLOCK.symbol($name, :scope($scope));
-            }
-        }
-    }
+    #  ...and at the end of the block's initializer (after any other
+    #  items added by the block), we finalize the composition
+    $block[0].push( PAST::Op.new( :name('!meta_compose'), $?METACLASS) );
 
-    # Signature.
-    elsif $<scoped><declarator><signature> {
-        # We'll emit code to declare each of the parameters, then we'll have
-        # the declaration evaluate to the signature object, thus allowing an
-        # assignment to it.
-        my @declare := sig_extract_declarables($/, $past);
-        $past := PAST::Op.new(:name('list'), :node($/) );
-        for @declare {
-            # Work out sigil and twigil.
-            my $sigil := substr($_, 0, 1);
-            my $twigil := substr($_, 1, 1);
-            my $desigilname;
-            if $twigil eq '.' || $twigil eq '!' {
-                $desigilname := substr($_, 2);
-            }
-            else {
-                $twigil := '';
-                $desigilname := substr($_, 1);
-            }
+    make $block;
+}
+
+
+method scope_declarator($/) {
+    our @?BLOCK;
+    my $block := @?BLOCK[0];
+    my $sym   := ~$<sym>;
+    my $past  := $( $<scoped> );
+    my $scope := 'lexical';
+    if    $sym eq 'our' { $scope := 'package'; }
+    elsif $sym eq 'has' { $scope := 'attribute'; }
+
+    #  Private methods get a leading !.
+    if $scope eq 'lexical' && $past.isa(PAST::Block)
+        && $past.blocktype() eq 'method' {
+            $past.name( '!' ~ $past.name());
+    }
+
+    #  If we have a single variable, we temporarily pack it into
+    #  a PAST::Op node (like a signature of one variable) and
+    #  let the PAST::Op code below handle it.  It then gets
+    #  unpacked at the end.
+    if $past.isa(PAST::Var) {
+        $past := PAST::Op.new( $past );
+    }
+
+    if $past.isa(PAST::Op) {
+        my $i := 0;
+        for @($past) {
+            if $_.isa(PAST::Var) {
+                my $var := $_;
+
+                # This is a variable declaration, so we set the scope in
+                # the block's symbol table as well as the variable itself.
+                $block.symbol( $var.name(), :scope($scope) );
+                $var.scope($scope);
+                $var.isdecl(1);
+                if $scope eq 'package' { $var.lvalue(1); }
+                my $init_value := $var.viviself();
+                my $type;
+                if +@($var<type>) { $type := $var<type>[0]; }  # FIXME
+
+                # If the var has a '.' twigil, we need to create an
+                # accessor method for it in the block (class/grammar/role)
+                if $var<twigil> eq '.' {
+                    my $method := PAST::Block.new( :blocktype('method') );
+                    $method.name( substr($var.name(), 2) );
+                    my $value := PAST::Var.new( :name($var.name()) );
+                    my $readtype := trait_readtype( $var<traitlist> ) || 'readonly';
+                    if $readtype eq 'CONFLICT' {
+                        $<scoped>.panic(
+                            "Can use only one of readonly, rw, and copy on "
+                            ~ $var.name() ~ " parameter"
+                        );
+                    }
+                    elsif $readtype ne 'rw' {
+                        $value := PAST::Op.new( :pirop('new PsP'),
+                                      'ObjectRef', $value);
+                        $value := PAST::Op.new( :pirop('setprop'),
+                                      $value, 'readonly', 1);
+                    }
+                    $method.push( $value );
+                    $block[0].push($method);
+                }
 
-            # Decide by declarator.
-            if $declarator eq 'my' || $declarator eq 'our' {
-                # Add declaration code.
-                my $scope;
-                if $declarator eq 'my' {
-                    $scope := 'lexical'
+                if $scope eq 'attribute' {
+                    my $pkgdecl := $block<pkgdecl>;
+                    unless $pkgdecl eq 'class' || $pkgdecl eq 'role'
+                            || $pkgdecl eq 'grammar' {
+                        $/.panic("Attempt to define attribute " ~ $var.name() ~
+                                 " outside of class, role, or grammar");
+                    }
+                    # Attribute declaration.  Add code to the beginning
+                    # of the block (really class/grammar/role) to
+                    # create the attribute.
+                    our $?METACLASS;
+                    my $has := PAST::Op.new( :name('!meta_attribute'),
+                                   $?METACLASS, $var.name(), $var<itype> );
+                    if $type { $type.named('type'); $has.push($type); }
+                    if $init_value {
+                        $init_value.named('init_value');
+                        $has.push($init_value);
+                    }
+                    if $var<traitlist> {
+                        $var<traitlist>.named('traitlist');
+                        $has.push($var<traitlist>);
+                    }
+                    $block[0].push( $has );
                 }
                 else {
-                    $scope := 'package';
+                    # $scope eq 'package' | 'lexical'
+                    my $viviself := PAST::Op.new( :pirop('new PsP'), $var<itype> );
+                    if $init_value { $viviself.push( $init_value ); }
+                    $var.viviself( $viviself );
+                    if $type {
+                        $var := PAST::Op.new( :pirop('setprop'),
+                                              $var, 'type', $type );
+                    }
                 }
-                $past.push(PAST::Var.new(
-                    :name($_),
-                    :isdecl(1),
-                    :scope($scope),
-                    :viviself(container_type($sigil))
-                ));
-
-                # Add block entry.
-                $?BLOCK.symbol($_, :scope($scope));
-            } elsif $declarator eq 'has' {
-                declare_attribute($/, $declarator, $sigil, $twigil, $desigilname);
-            }
-            else {
-                $/.panic("Scope declarator " ~ $declarator ~ " unimplemented with signatures.");
+                $past[$i] := $var;
             }
+            $i++;
         }
+        if $scope eq 'attribute' {
+            $past.pasttype('null');
+            $past<scopedecl> := $scope;
+        }
+        elsif +@($past) == 1 { $past := $past[0]; }
+        else { $past.name('infix:,'); $past.pasttype('call'); }
     }
+    make $past;
+}
 
-    # Routine?
-    elsif $<scoped><routine_declarator> {
-        # What declarator?
-        if $declarator eq 'our' {
-            # Default, nothing to do.
-        }
-        elsif $declarator eq 'my' {
-            if $<scoped><routine_declarator><sym> eq 'method' {
-                # Add ! to start of name.
-                $past.name('!' ~ $past.name());
-            }
-            else {
-                $/.panic("Lexically scoped subs not yet implemented.");
+
+method scoped($/) {
+    my $past;
+    if $<declarator> {
+        $past := $( $<declarator> );
+    }
+    elsif $<multi_declarator> {
+        $past := $( $<multi_declarator> );
+        if $past.isa(PAST::Var) {
+            my $type := $past<type>;
+            for @($<fulltypename>) {
+                $type.push( $( $_ ) );
             }
-        }
-        else {
-            $/.panic("Cannot apply declarator '" ~ $declarator ~ "' to a routine.");
+            $past.viviself( $( $<fulltypename>[0] ).clone() );
         }
     }
-
-    # Something else we've not implemetned yet?
-    else {
-        $/.panic("Don't know how to apply a scope declarator here.");
-    }
-
     make $past;
 }
 
 
-method variable($/, $key) {
+method declarator($/) {
     my $past;
-    if $key eq 'special_variable' {
-        $past := $( $<special_variable> );
+    if $<variable_declarator> {
+        $past := $( $<variable_declarator> );
     }
-    elsif $key eq '$0' {
-        $past := PAST::Var.new(
-            :scope('keyed_int'),
-            :node($/),
-            :viviself('Failure'),
-            PAST::Var.new(
-                :scope('lexical'),
-                :name('$/')
-            ),
-            PAST::Val.new(
-                :value(~$<matchidx>),
-                :returns('Int')
-            )
-        );
+    elsif $<signature> {
+        $past := $( $<signature> );
+        our $?BLOCK_OPEN;
+        $?BLOCK_OPEN := 0;
     }
-    elsif $key eq '$<>' {
-        $past := $( $<postcircumfix> );
-        $past.unshift(PAST::Var.new(
-            :scope('lexical'),
-            :name('$/'),
-            :viviself('Failure')
-        ));
+    elsif $<routine_declarator> {
+        $past := $( $<routine_declarator> );
     }
-    elsif $key eq '$var' {
-        our $?BLOCK;
-        # Handle naming.
-        my @identifier := Perl6::Compiler.parse_name($<name>);
-        my $name := @identifier.pop();
-
-        my $twigil := ~$<twigil>[0];
-        my $sigil := ~$<sigil>;
-        my $fullname := $sigil ~ $twigil ~ ~$name;
-
-        if $fullname eq '@_' || $fullname eq '%_' {
-            unless $?BLOCK.symbol($fullname) {
-                $?BLOCK.symbol( $fullname, :scope('lexical') );
-                my $var;
-                if $sigil eq '@' {
-                    $var := PAST::Var.new( :name($fullname), :scope('parameter'), :slurpy(1) );
-                }
-                else {
-                    $var := PAST::Var.new( :name($fullname), :scope('parameter'), :slurpy(1), :named(1) );
-                }
-                $?BLOCK[0].unshift($var);
-            }
+    make $past;
+}
+
+
+method variable_declarator($/) {
+    our @?BLOCK;
+    my $var    := $( $<variable> );
+
+    ##  The $<variable> subrule might've saved a PAST::Var node for
+    ##  us (e.g., $.x), if so, use it instead.
+
+    if $var<vardecl> { $var := $var<vardecl>; }
+    my $name   := $var.name();
+    my $symbol := @?BLOCK[0].symbol( $name );
+    if $symbol<scope> eq 'lexical' {
+        $/.panic("Redeclaration of variable " ~ $name);
+    }
+
+    $var.isdecl(1);
+    $var<type>  := PAST::Op.new( :name('and'), :pasttype('call') );
+    $var<itype> := container_itype($<variable><sigil>);
+
+    if $<trait> {
+        my $traitlist := PAST::Op.new( :name('infix:,'), :pasttype('call') );
+        $var<traitlist> := $traitlist;
+        for @($<trait>) { $traitlist.push( $( $_ ) ); }
+    }
+
+    make $var;
+}
+
+method variable($/, $key) {
+    my $var;
+    our @?BLOCK;
+    my $?BLOCK := @?BLOCK[0];
+    if $key eq 'desigilname' {
+        my $sigil    := ~$<sigil>;
+        if $sigil eq '&' { $sigil := ''; }
+        my $twigil   := ~$<twigil>[0];
+        my @ns       := Perl6::Compiler.parse_name( $<desigilname> );
+        my $name     := ~@ns.pop();
+        my $varname  := $sigil ~ $twigil ~ $name;
+
+        # If no twigil, but varname is 'attribute' in outer scope,
+        # it's really a private attribute and implies a '!' twigil
+        if !$twigil {
+            my $sym := outer_symbol($varname);
+            if $sym && $sym<scope> eq 'attribute' {
+                $twigil  := '!';
+                $varname := $sigil ~ $twigil ~ $name;
+            };
         }
 
+        # If twigil is ^ or :, it's a placeholder var.  Create the
+        # parameter for the block if one doesn't already exist.
         if $twigil eq '^' || $twigil eq ':' {
-            if $?BLOCK.symbol('___HAVE_A_SIGNATURE') {
-                $/.panic('A signature must not be defined on a sub that uses placeholder vars.');
+            if $?BLOCK<explicit_signature> {
+                $/.panic("Cannot use placeholder var in block with signature.");
             }
-            unless $?BLOCK.symbol($fullname) {
-                $?BLOCK.symbol( $fullname, :scope('lexical') );
+            $twigil := '';
+            $varname := $sigil ~ $name;
+            unless $?BLOCK.symbol($varname) {
+                $?BLOCK.symbol( $varname, :scope('lexical') );
                 $?BLOCK.arity( +$?BLOCK.arity() + 1 );
-                my $var := PAST::Var.new(:name($fullname), :scope('parameter'));
-                if $twigil eq ':' { $var.named( ~$name ); }
+                my $param := PAST::Var.new(:name($varname), :scope('parameter'));
+                if $twigil eq ':' { $param.named( $name ); }
                 my $block := $?BLOCK[0];
                 my $i := +@($block);
-                while $i > 0 && $block[$i-1]<name> gt $fullname {
+                while $i > 0 && $block[$i-1].name() gt $varname {
                     $block[$i] := $block[$i-1];
                     $i--;
                 }
-                $block[$i] := $var;
+                $block[$i] := $param;
+
+                # XXX Need to generate Signature accounting for the placeholders.
+                $?BLOCK<signature> := 1;
             }
         }
 
-        # If it's $.x, it's a method call, not a variable.
-        if $twigil eq '.' {
-            $past := PAST::Op.new(
-                :node($/),
-                :pasttype('callmethod'),
-                :name($name),
-                PAST::Var.new(
-                    :name('self'),
-                    :scope('lexical'),
-                    :node($/)
-                )
-            );
+        $var := PAST::Var.new( :name($varname), :node($/) );
+        if $twigil { $var<twigil> := $twigil; }
+
+        # If namespace qualified or has a '*' twigil, it's a package var.
+        if @ns || $twigil eq '*' {
+            $var.namespace(@ns);
+            $var.scope('package');
+            $var.viviself( container_itype($sigil) );
         }
-        else {
-            # Variable. [!:^] twigil should be kept in the name.
-            if $twigil eq '!' || $twigil eq ':' || $twigil eq '^' || $twigil eq '?' {
-                $name := $twigil ~ ~$name;
-            }
 
-            # All but subs should keep their sigils.
-            my $sigil := '';
-            if $<sigil> ne '&' {
-                $sigil := ~$<sigil>;
+        ## @_ and %_ add a slurpy param to the block
+        if $varname eq '@_' || $varname eq '%_' {
+            unless $?BLOCK.symbol($varname) {
+                $?BLOCK.symbol( $varname, :scope('lexical') );
+                my $param := PAST::Var.new( :name($varname),
+                                            :scope('parameter'),
+                                            :slurpy(1) );
+                if $sigil eq '%' { $param.named(1); }
+                $?BLOCK[0].unshift($param);
             }
+        }
 
-            # If we have no twigil, but we see the name noted as an attribute in
-            # an enclosing scope, add the ! twigil anyway; it's an alias.
-            if $twigil eq '' {
-                our @?BLOCK;
-                for @?BLOCK {
-                    if defined( $_ ) {
-                        my $sym_table := $_.symbol($sigil ~ $name);
-                        if defined( $sym_table )
-                                && $sym_table<scope> eq 'attribute' {
-                            $name := '!' ~ $name;
-                            $twigil := '!';
-                        }
-                    }
-                }
-            }
+        # Until PCT has 'name' scope, we handle lexical/package lookup here.
+        if $<sigil> eq '&' {
+            $var.scope('package');
+            my $sym := outer_symbol($varname);
+            if $sym && $sym<scope> { $var.scope( $sym<scope> ); }
+        }
 
-            # If it's a role-private attribute, fix up the name.
-            if $twigil eq '!' {
-                our @?BLOCK;
-                for @?BLOCK {
-                    if defined( $_ ) {
-                        my $sym_table := $_.symbol($sigil ~ $name);
-                        if defined( $sym_table )
-                                && $sym_table<scope> eq 'rpattribute' {
-                            $name := $sym_table<real_name>;
-                        }
-                    }
-                }
-            }
+        # ! and . twigils may need 'self' for attribute lookup ...
+        if $twigil eq '!' || $twigil eq '.' {
+            $var.unshift( PAST::Var.new( :name('self'), :scope('lexical') ) );
+        }
 
-            $past := PAST::Var.new(
-                :name( $sigil ~ $name ),
-                :node($/)
+        # ...but return . twigil as a method call, saving the
+        # PAST::Var node in $var<vardecl> where it can be easily
+        # retrieved by <variable_declarator> if we're called from there.
+        if $twigil eq '.' {
+            my $vardecl := $var;
+            $vardecl.name( $sigil ~ '!' ~ $name );
+            $var := PAST::Op.new( :node($/), :pasttype('callmethod'),
+                :name($name),
+                PAST::Var.new( :name('self'), :scope('lexical') )
             );
-            if @identifier || $twigil eq '*' {
-                $past.namespace(@identifier);
-                $past.scope('package');
-            }
-
-            # If it has a ! twigil, give it attribute scope and add self.
-            if $twigil eq '!' {
-                $past.scope('attribute');
-                $past.unshift(PAST::Var.new(
-                    :name('self'),
-                    :scope('lexical')
-                ));
-            }
-
-            # If we have something with an & sigil see if it has any entries
-            # in the enclosing blocks; otherwise, default to package.
-            if $<sigil> eq '&' {
-                $past.scope('package');
-                our @?BLOCK;
-                for @?BLOCK {
-                    if defined($_) {
-                        my $sym_table := $_.symbol($name);
-                        if defined($sym_table) && defined($sym_table<scope>) {
-                            $past.scope( $sym_table<scope> );
-                        }
-                    }
-                }
-            }
-
-            # If we have the ? sigil, lexical scope.
-            if $twigil eq '?' {
-                $past.scope('lexical');
-            }
-
-            $past.viviself(container_type($sigil));
+            $var<vardecl> := $vardecl;
         }
     }
-    make $past;
+    elsif $key eq 'special_variable' {
+        $var := $( $<special_variable> );
+    }
+    make $var;
+}
+
+
+method special_variable($/) {
+    make PAST::Var.new( :node($/), :name(~$/), :scope('lexical') );
 }
 
 
@@ -2689,6 +1797,40 @@
 }
 
 
+method typename($/) {
+    # Extract shortname part of identifier, if there is one.
+    my $ns := Perl6::Compiler.parse_name($<name>);
+    my $shortname := $ns.pop();
+
+    # determine type's scope
+    my $scope := '';
+    our @?BLOCK;
+    if +$ns == 0 && @?BLOCK {
+        for @?BLOCK {
+            if defined($_) && !$scope {
+                my $sym := $_.symbol($shortname);
+                if defined($sym) && $sym<scope> { $scope := $sym<scope>; }
+            }
+        }
+    }
+
+    # Create default PAST node for package lookup of type.
+    my $past := PAST::Var.new(
+        :name($shortname),
+        :namespace($ns),
+        :node($/),
+        :scope($scope || 'package'),
+    );
+
+    make $past;
+}
+
+
+method fulltypename($/) {
+    make $( $<typename> );
+}
+
+
 method number($/, $key) {
     make $( $/{$key} );
 }
@@ -2834,36 +1976,6 @@
 }
 
 
-method typename($/) {
-    # Extract shortname part of identifier, if there is one.
-    my $ns := Perl6::Compiler.parse_name($<name>);
-    my $shortname := $ns.pop();
-
-    # determine type's scope
-    my $scope := '';
-    our @?BLOCK;
-    if +$ns == 0 && @?BLOCK {
-        for @?BLOCK {
-            if defined($_) && !$scope {
-                my $sym := $_.symbol($shortname);
-                if defined($sym) && $sym<scope> { $scope := $sym<scope>; }
-            }
-        }
-    }
-
-    # Create default PAST node for package lookup of type.
-    my $past := PAST::Var.new(
-        :name($shortname),
-        :namespace($ns),
-        :node($/),
-        :scope($scope ?? $scope !! 'package'),
-        :viviself('Failure')
-    );
-
-    make $past;
-}
-
-
 method term($/, $key) {
     my $past;
     if $key eq 'noarg' {
@@ -2936,26 +2048,14 @@
         my $rhs := $( $/[1] );
         my $past;
 
-        # Is it an assignment to an attribute?
-        if $lhs.isa(PAST::Var) && $lhs.scope() eq 'attribute' && $lhs.isdecl() {
-            # Add this to the WHENCE clause.
-            # XXX Need to make it a closure, but will need :subid to get
-            # scoping right.
-            our $?CLASS;
-            $?CLASS.push(
-                PAST::Op.new(
-                    :pasttype('call'),
-                    :name('!ADD_TO_WHENCE'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register')
-                    ),
-                    $lhs.name(),
-                    $rhs
-                )
+        if $lhs<scopedecl> eq 'attribute' {
+            $rhs.named('init_value');
+            our $?METACLASS;
+            $past := PAST::Op.new( :name('!meta_attribute'),
+                         $?METACLASS, $lhs[0].name(), $rhs
             );
-
-            # Nothing to emit at this point.
+            our @?BLOCK;
+            @?BLOCK[0][0].push($past);
             $past := PAST::Stmts.new();
         }
         else {
@@ -3158,8 +2258,8 @@
 
     # Put this code in loadinit, so the type is created early enough,
     # then this node results in an empty statement node.
-    our $?BLOCK;
-    $?BLOCK.loadinit().push($past);
+    our @?BLOCK;
+    @?BLOCK[0].loadinit().push($past);
 
     make PAST::Stmts.new();
 }
@@ -3244,6 +2344,18 @@
 }
 
 
+# search through outer blocks for a symbol table entry
+sub outer_symbol($name) {
+    our @?BLOCK;
+    my $symbol;
+    for @?BLOCK {
+        $symbol := $_.symbol($name);
+        if $symbol { return $symbol; }
+    }
+    return $symbol;
+}
+
+
 # Used by all calling code to process arguments into the correct form.
 sub build_call($args) {
     if !$args.isa(PAST::Op) || $args.name() ne 'infix:,' {
@@ -3316,77 +2428,24 @@
 }
 
 
-sub container_type($sigil) {
-    if    $sigil eq '@' { return 'Perl6Array'  }
-    elsif $sigil eq '%' { return 'Perl6Hash'   }
-    else                { return 'Perl6Scalar' }
+sub container_itype($sigil) {
+    if    $sigil eq '@' { return 'Perl6Array' }
+    elsif $sigil eq '%' { return 'Perl6Hash'  }
+    else                { return 'ObjectRef'  }
 }
 
 
-# Processes a handles expression to produce the appropriate method(s).
-sub process_handles($/, $expr, $attr_name) {
-    my $past := PAST::Stmts.new();
-
-    # What type of expression do we have?
-    if $expr.isa(PAST::Val) && $expr.returns() eq 'Str' {
-        # Just a single string mapping.
-        my $name := ~$expr.value();
-        my $method := make_handles_method($/, $name, $name, $attr_name);
-        $past.push(add_method_to_class($method));
-    }
-    elsif $expr.isa(PAST::Op) && $expr.returns() eq 'Pair' {
-        # Single pair.
-        my $method := make_handles_method_from_pair($/, $expr, $attr_name);
-        $past.push(add_method_to_class($method));
-    }
-    elsif $expr.isa(PAST::Op) && $expr.pasttype() eq 'call' &&
-          $expr.name() eq 'list' {
-        # List of something, but what is it?
-        for @($expr) {
-            if $_.isa(PAST::Val) && $_.returns() eq 'Str' {
-                # String value.
-                my $name := ~$_.value();
-                my $method := make_handles_method($/, $name, $name, $attr_name);
-                $past.push(add_method_to_class($method));
-            }
-            elsif $_.isa(PAST::Op) && $_.returns() eq 'Pair' {
-                # Pair.
-                my $method := make_handles_method_from_pair($/, $_, $attr_name);
-                $past.push(add_method_to_class($method));
-            }
-            else {
-                $/.panic(
-                    'Only a list of constants or pairs can be used in handles'
-                );
-            }
-        }
-    }
-    elsif $expr.isa(PAST::Stmts) && $expr[0].name() eq 'infix:,' {
-        # Also a list, but constructed differently.
-        for @($expr[0]) {
-            if $_.isa(PAST::Val) && $_.returns() eq 'Str' {
-                # String value.
-                my $name := ~$_.value();
-                my $method := make_handles_method($/, $name, $name, $attr_name);
-                $past.push(add_method_to_class($method));
-            }
-            elsif $_.isa(PAST::Op) && $_.returns() eq 'Pair' {
-                # Pair.
-                my $method := make_handles_method_from_pair($/, $_, $attr_name);
-                $past.push(add_method_to_class($method));
-            }
-            else {
-                $/.panic(
-                    'Only a list of constants or pairs can be used in handles'
-                );
+sub trait_readtype($traitpast) {
+    my $readtype;
+    if $traitpast {
+        for @($traitpast) {
+            my $tname := $_[1];
+            if $tname eq 'readonly' || $tname eq 'rw' || $tname eq 'copy' {
+                $readtype := $readtype ?? 'CONFLICT' !! $tname;
             }
         }
     }
-    else {
-        $/.panic('Illegal or unimplemented use of handles');
-    }
-
-    $past
+    $readtype;
 }
 
 
@@ -3451,150 +2510,6 @@
 }
 
 
-# This takes an array of match objects of type constraints and builds a type
-# representation out of them.
-sub build_type($cons_pt) {
-    # Build the type constraints list for the variable.
-    my $num_types := 0;
-    my $type_cons := PAST::Op.new();
-    for $cons_pt {
-        $type_cons.push( $( $_<typename> ) );
-        $num_types := $num_types + 1;
-    }
-
-    # If there were none, it's Object.
-    if $num_types == 0 {
-        $type_cons.push(PAST::Var.new(
-            :name('Object'),
-            :scope('package')
-        ));
-        $num_types := 1;
-    }
-
-    # Now need to apply the type constraints. How many are there?
-    if $num_types == 1 {
-        # Just the first one.
-        $type_cons := $type_cons[0];
-    }
-    else {
-        # Many; make an and junction of types.
-        $type_cons.pasttype('call');
-        $type_cons.name('all');
-    }
-
-    $type_cons
-}
-
-
-# Takes a block and turns it into a sub.
-sub create_sub($/, $past) {
-    $past.blocktype('declaration');
-    set_block_proto($past, 'Sub');
-    my $multisig := $<routine_def><multisig>;
-    if $multisig {
-        set_block_sig($past, $( $multisig[0]<signature> ));
-    }
-    else {
-        set_block_sig($past, empty_signature());
-    }
-}
-
-
-# Set the proto object type of a block.
-sub set_block_proto($block, $type) {
-    my $loadinit := $block.loadinit();
-    $loadinit.push(
-        PAST::Op.new(
-            :inline('setprop %0, "$!proto", %1'),
-            PAST::Var.new( :name('block'), :scope('register') ),
-            PAST::Var.new( :name($type), :scope('package') )
-        )
-    );
-}
-
-
-# Associate a signature object with a block.
-sub set_block_sig($block, $sig_obj) {
-    my $loadinit := $block.loadinit();
-    $loadinit.push(
-        PAST::Op.new(
-            :inline('setprop %0, "$!signature", %1'),
-            PAST::Var.new( :name('block'), :scope('register') ),
-            $sig_obj
-        )
-    );
-}
-
-
-# Create an empty signautre object for subs with no signatures.
-sub empty_signature() {
-    PAST::Op.new(
-        :pasttype('callmethod'),
-        :name('!create'),
-        PAST::Var.new(
-            :name('Signature'),
-            :scope('package'),
-            :namespace(list())
-        )
-    )
-}
-
-
-# Creates a signature descriptor (for now, just a hash).
-sub sig_descriptor_create() {
-    PAST::Stmts.new(
-        PAST::Op.new( :inline('    $P1 = new "Hash"') ),
-        PAST::Stmts.new(),
-        PAST::Op.new( :inline('    %r = $P1') )
-    )
-}
-
-# Sets a given value in the signature descriptor.
-sub sig_descriptor_set($descriptor, $name, $value) {
-    $descriptor[1].push(PAST::Op.new(
-        :inline('    $P1[%0] = %1'),
-        PAST::Val.new( :value(~$name) ),
-        $value
-    ));
-}
-
-# Returns a list of variables from a signature that we are to declare. Panics
-# if the signature is too complex to unpack.
-sub sig_extract_declarables($/, $sig_setup) {
-    # Just make sure it's what we expect.
-    if !$sig_setup.isa(PAST::Op) || $sig_setup.pasttype() ne 'callmethod' ||
-       $sig_setup[0].name() ne 'Signature' {
-        $/.panic("sig_extract_declarables was not passed signature declaration PAST!");
-    }
-
-    # Now go through what signature and extract what to declare.
-    my @result := list();
-    my $first := 1;
-    for @($sig_setup) {
-        if $first {
-            # Skip over invocant.
-            $first := 0;
-        }
-        else {
-            # If it has a name, we're fine; if not, it's something odd - give
-            # it a miss for now.
-            my $found_name := undef;
-            for @($_[1]) {
-                if $_[0].value() eq 'name' {
-                    $found_name := ~$_[1].value();
-                }
-            }
-            if defined($found_name) {
-                @result.push($found_name);
-            }
-            else {
-                $/.panic("Signature too complex for LHS of assignment.");
-            }
-        }
-    }
-    @result
-}
-
 # Generates a setter/getter method for an attribute in a class or role.
 sub make_accessor($/, $method_name, $attr_name, $rw, $scope) {
     my $getset;
@@ -3742,6 +2657,19 @@
 }
 
 
+# Adds an empty signature to a routine if it is missing one.
+sub create_signature_if_none($block) {
+    unless $block<signature> {
+        my $sigobj   := PAST::Var.new( :scope('register') );
+        $block.loadinit().push(
+            PAST::Op.new( :inline('    %0 = new "Signature"',
+                                  '    setprop block, "$!signature", %0'),
+                           $sigobj)
+        );
+    }
+}
+
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: branches/rvar2/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/grammar.pg	(original)
+++ branches/rvar2/languages/perl6/src/parser/grammar.pg	Wed Jan  7 09:13:27 2009
@@ -355,46 +355,61 @@
 #### Subroutine and method definitions ####
 
 rule multi_declarator {
-    $<sym>=[multi|proto|only] 
-    [ <routine_declarator> {*}                   #= routine_declarator
-    | <routine_def> {*}                          #= routine_def
+    [
+    | $<sym>=[multi|proto|only] [ <declarator> || <routine_def> ]
+    | <declarator>
     ]
+    {*}
 }
 
 token routine_declarator {
-    | $<sym>='sub' <routine_def> {*}             #= sub
-    | $<sym>='method' <method_def> {*}           #= method
+    | $<sym>='sub'       <routine_def> {*}       #= sub
+    | $<sym>='method'    <method_def> {*}        #= method
     | $<sym>='submethod' <method_def> {*}        #= submethod
 }
 
+rule multisig {
+    ':'?'(' ~ ')' <signature>
+    {*}
+}
+
 rule routine_def {
-    <identifier>? <multisig>?
-    <trait>*
+    [ <deflongname=identifier> ]? [ <multisig> | <trait> ]*
     <block>
     {*}
 }
 
 rule method_def {
-    <identifier>? <multisig>?
-    <trait>*
+    [
+    | <longname=name> [ <multisig> | <trait> ]*
+    ]
     <block>
     {*}
 }
 
 rule trait {
+    [
     | <trait_auxiliary>
     | <trait_verb>
+    ]
+    {*}
 }
 
 rule trait_auxiliary {
+    [
     | $<sym>=[is] <name><postcircumfix>?
     | $<sym>=[does] <name>['['<EXPR>']']?
     | $<sym>=[will] <identifier> <block>
+    ]
+    {*}
 }
 
 rule trait_verb {
+    [
     | $<sym>=[of|returns] <typename>
     | $<sym>=[handles] <EXPR>
+    ]
+    {*}
 }
 
 token capterm {
@@ -407,29 +422,27 @@
     {*}
 }
 
-rule multisig {
-    '(' <signature> ')'
+token sigterm {
+    ':(' ~ ')' <signature> {*}
 }
 
-token signature {
-    ( <parameter> <.ws> ( ',' <.ws> | ':' <.ws> | ';;' <.ws> | <?before ')' | '{'> ) )* <.ws>
-    {*}
-}
+rule param_sep { (','|':'|';;'|';') }
 
-token sigterm {
-    ':(' 
-    {{
-        $P0 = new 'Integer'
-        $P0 = 1
-        set_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '$?SIG_BLOCK_NOT_NEEDED', $P0
-    }}
-    ~ ')' <signature>
-    {{
-        $P0 = new 'Integer'
-        $P0 = 0
-        set_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '$?SIG_BLOCK_NOT_NEEDED', $P0
-    }}
-    {*}
+token signature {
+    {*} #= open
+    <.ws>
+    [
+    | <parameter>
+    | <?before '-->' | ')' | ']' | '{' | ':'<!before ':' > >
+    ] ** 1 ## PGE bug
+    [ <param_sep>
+        [
+        | <parameter>
+        | <?before '-->' | ')' | ']' | '{' | ':'<!before ':' > >
+        ]
+    ]*
+    <.ws>
+    {*} #= close
 }
 
 rule type_declarator {
@@ -445,13 +458,19 @@
 # commented out.
 rule type_constraint {
     [
-    | <typename>
-    | where <EXPR: 'm='> # XXX <EXPR(%chaining)>
+    | <fulltypename>
+    | where <EXPR: 'm='>               # XXX <EXPR(item %chaining)>
     ]
+    {*}
 }
 
 rule post_constraint {
-    where <EXPR: 'm='> # XXX <EXPR(%chaining)>
+    where <EXPR: 'm='>                 # XXX <EXPR(item %chaining)>
+}
+
+token param_var {
+    <sigil> <twigil>? <identifier>
+    {*}
 }
 
 token parameter {
@@ -472,17 +491,6 @@
     '=' <EXPR: 'i='>
 }
 
-token param_var {
-    <sigil> <twigil>? <identifier>
-    {*}
-}
-
-
-#### Special variables ####
-
-token special_variable {
-    $<sym>=[ '$/' | '$!' | '$¢' ] <!before \w> {*}
-}
 
 #### Terms ####
 
@@ -545,15 +553,15 @@
 # XXX Note that 'self' here should be a term.
 token noun {
     | <fatarrow> {*}                             #= fatarrow
+    | <variable> {*}                             #= variable
     | <package_declarator> {*}                   #= package_declarator
     | <scope_declarator> {*}                     #= scope_declarator
-    | <multi_declarator> {*}                     #= multi_declarator
     | <routine_declarator> {*}                   #= routine_declarator
+    | <?before multi|proto|only> <multi_declarator> {*}  #= multi_declarator
     | <regex_declarator> {*}                     #= regex_declarator
     | <type_declarator> {*}                      #= type_declarator
     | <enum_declarator> {*}                      #= enum_declarator
     | <circumfix> {*}                            #= circumfix
-    | <variable> {*}                             #= variable
     | <statement_prefix> {*}                     #= statement_prefix
     | <dotty> {*}                                #= dotty
     | <value> {*}                                #= value
@@ -597,44 +605,21 @@
 }
 
 rule package_declarator {
-    [
-    | $<sym>=[class|grammar|module|package] {*}  #= open
-      <package_def> {*}                          #= package_def
-    | $<sym>=[role] {*}                          #= open
-      <role_def> {*}                             #= role_def
-    ]
+    $<sym>=[class|grammar|module|package|role] {*}       #= open
+    <package_def> {*}                                    #= package_def
 }
 
 
 rule package_def {
-    <name>? <trait>* {*}                         #= open
-    <package_block> {*}                          #= close
-}
-
-
-rule role_def {
-    <name>['['<signature>']']? <trait>* {*}      #= open
-    <package_block> {*}                          #= close
-}
-
-
-rule package_block {
     [
-    || ';' <statement_block> {*}                 #= statement_block
-    || <block> {*}                               #= block
-    ]
-}
-
-
-token variable_declarator {
-    <variable>
+        <module_name=name>
+    ]? 
     <trait>*
-# XXX let EXPR handle this automatically until we can pass arguments
-#    <.ws>
-#    [ # XXX <EXPR(%item_assignment)>
-#    | $<op>=['='|'.='] <.ws> <EXPR>
-#    ]?
-    {*}
+    [
+    | ';' <statement_block> {*}                          #= statement_block
+    | <block> {*}                                        #= block
+    | {*}                                                #= panic
+    ]
 }
 
 
@@ -646,61 +631,72 @@
     ]
 }
 
-
-token declarator {
-    [
-    | <variable_declarator>
-    | '(' 
-      {{
-          $P0 = new 'Integer'
-          $P0 = 1
-          set_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '$?SIG_BLOCK_NOT_NEEDED', $P0
-      }}
-      ~ ')' <signature>
-      {{
-          $P0 = new 'Integer'
-          $P0 = 0
-          set_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '$?SIG_BLOCK_NOT_NEEDED', $P0
-      }}
-    ]
+rule scope_declarator {
+    $<sym>=[my|our|state|constant|has]
+    <scoped>
     {*}
 }
 
-
 rule scoped {
-    <fulltypename>*
     [
     | <declarator>
     | <routine_declarator>
+    | <fulltypename>+ <multi_declarator>
     ]
     {*}
 }
 
-
-rule scope_declarator {
-    $<sym>=[my|our|state|constant|has]
-    <scoped>
+token declarator {
+    [
+    | <variable_declarator>
+    | '(' ~ ')' <signature> <trait>*
+    | <routine_declarator>
+    | <regex_declarator>
+    | <type_declarator>
+    ]
     {*}
 }
 
-token circumfix {
-    | '(' <statementlist> ')' {*}                #= ( )
-    | '[' <statementlist> ']' {*}                #= [ ]
-    | <?before '{' | <lambda> > <pblock> {*}     #= { }
-    | <sigil> '(' <semilist> ')' {*}             #= $( )
+token variable_declarator {
+    <variable>
+    <.ws>
+    <trait>*
+    <post_constraint>*
+    {*}
 }
 
 token variable {
-    | <special_variable> {*}                     #= special_variable
-    | <sigil> <twigil>? <name> {*}               #= $var
-    | <sigil> $<matchidx>=[\d+] {*}              #= $0
-    | <sigil> <?before '<' > <postcircumfix> {*} #= $<>
+    <?sigil>
+    [
+    | <sigil> <twigil>? <desigilname> {*}                #= desigilname
+    | <special_variable> {*}                             #= special_variable
+    | <sigil> $<matchidx>=[\d+] {*}                      #= $0
+    | <sigil> <?before '<'> <postcircumfix> {*}          #= $<>
+    ]
 }
 
 token sigil { '$' | '@' | '%' | '&' | '@@' }
 
 token twigil { <[.!^:*+?=]> }
 
+token desigilname {
+    [
+    | <?before '$' > <variable>
+    | <longname=name>
+    ]
+}
+
+token special_variable {
+    $<sym>=[ '$/' | '$!' | '$¢' ] <!before \w> {*}
+}
+
+token circumfix {
+    | '(' <statementlist> ')' {*}                #= ( )
+    | '[' <statementlist> ']' {*}                #= [ ]
+    | <?before '{' | <lambda> > <pblock> {*}     #= { }
+    | <sigil> '(' <semilist> ')' {*}             #= $( )
+}
+
 token name {
     | <identifier> <morename>*
     | <morename>+
@@ -719,6 +715,18 @@
     | <number> {*}                               #= number
 }
 
+token typename {
+    <?before <.upper> | '::' > <name>
+    {*}
+}
+
+rule fulltypename {
+    <typename>
+#   [ of <fulltypename> ]?
+    {*}
+}
+
+
 ##  Quoting is tricky -- the <quote_concat> subrule is in
 ##  F<src/parser/quote_expression.pir> .
 token quote {
@@ -804,17 +812,6 @@
     {*}
 }
 
-rule fulltypename {
-    <typename>
-#   [ of <fulltypename> ]?
-    {*}
-}
-
-token typename {
-    <?before <.upper> | '::' > <name>
-    {*}
-}
-
 # These regex rules are some way off STD.pm at the moment, but we'll work them
 # closer to it over time.
 rule regex_declarator {
@@ -875,14 +872,6 @@
     ]
 }
 
-token desigilname {
-    [
-    | <?before '$' > <variable>
-    | <name>
-    ]
-    {*}
-}
-
 #### expressions and operators ####
 
 ##  The EXPR rule is our entry point into the operator

Modified: branches/rvar2/languages/perl6/src/pmc/objectref_pmc.template
==============================================================================
--- branches/rvar2/languages/perl6/src/pmc/objectref_pmc.template	(original)
+++ branches/rvar2/languages/perl6/src/pmc/objectref_pmc.template	Wed Jan  7 09:13:27 2009
@@ -23,8 +23,10 @@
     ATTR PMC *cached_type;
 
     VTABLE void init() {
-        /* Initialize with a null PMC for properties. */
-        STATICSELF.init_pmc(PMCNULL);
+        PMC * const hll_ns    = Parrot_get_ctx_HLL_namespace(INTERP);
+        STRING * const s_obj  = string_from_literal(INTERP, "!$OBJECTREF");
+        PMC * const objectpmc = Parrot_find_global_n(INTERP, hll_ns, s_obj);
+        STATICSELF.init_pmc(objectpmc);
     }
 
     VTABLE void init_pmc(PMC *value) {

Modified: branches/rvar2/languages/perl6/t/00-parrot/05-var.t
==============================================================================
--- branches/rvar2/languages/perl6/t/00-parrot/05-var.t	(original)
+++ branches/rvar2/languages/perl6/t/00-parrot/05-var.t	Wed Jan  7 09:13:27 2009
@@ -34,5 +34,5 @@
 
 ##   nested 'our' declarations
 
-our $x = 'not ok 12';  { our $x = 'ok 12'; };  say $x;
+$x = 'not ok 12';  { our $x = 'ok 12'; };  say $x;
 

Modified: branches/rvar2/languages/perl6/t/00-parrot/08-regex.t
==============================================================================
--- branches/rvar2/languages/perl6/t/00-parrot/08-regex.t	(original)
+++ branches/rvar2/languages/perl6/t/00-parrot/08-regex.t	Wed Jan  7 09:13:27 2009
@@ -19,7 +19,7 @@
 '5'  ~~ $r and say 'ok 6';
 '25' ~~ $r or  say 'ok 7';
 
-my $r = / 5 /;
+$r = / 5 /;
 $l   ~~ $r and say 'ok 8';
 5    ~~ $r and say 'ok 9';
 '5'  ~~ $r and say 'ok 10';

Modified: branches/rvar2/languages/perl6/t/pmc/objectref.t
==============================================================================
--- branches/rvar2/languages/perl6/t/pmc/objectref.t	(original)
+++ branches/rvar2/languages/perl6/t/pmc/objectref.t	Wed Jan  7 09:13:27 2009
@@ -25,7 +25,7 @@
     plan(4)
 
     init()
-    assign_val()
+    init_pmc()
     meth_call()
     multi_call()
 .end    
@@ -39,13 +39,12 @@
 .end
 
 
-.sub assign_val
+.sub init_pmc
     # Assigning a value.
-    $P1 = new 'ObjectRef'
     $P2 = get_hll_global 'Int'
     $P2 = $P2.'new'()
     $P2 = 42
-    assign $P1, $P2
+    $P1 = new 'ObjectRef', $P2
 
     # Get integer value; see what we have stored.
     $I0 = $P1
@@ -55,9 +54,8 @@
 
 .sub meth_call
     # Check we can call methods.
-    $P1 = new 'ObjectRef'
     $P2 = 'list'(1,2,3)
-    assign $P1, $P2
+    $P1 = new 'ObjectRef', $P2
     $I0 = $P1.'elems'()
     is($I0, 3, 'method calls on value work')
 .end
@@ -66,15 +64,13 @@
 .sub multi_call
     # Try and do a multi-dispatch call with two items.
     .local pmc x, y
-    x = new 'ObjectRef'
-    y = new 'ObjectRef'
     $P2 = get_hll_global 'Int'
     $P3 = $P2.'new'()
     $P3 = 35
-    x = $P3
+    x = new 'ObjectRef', $P3
     $P4 = $P2.'new'()
     $P4 = 7
-    y = $P4
+    y = new 'ObjectRef', $P4
     $P5 = 'infix:+'(x, y)
     $I0 = $P5
     is($I0, 42, 'multi call worked')

Modified: branches/rvar2/src/pmc/class.pmc
==============================================================================
--- branches/rvar2/src/pmc/class.pmc	(original)
+++ branches/rvar2/src/pmc/class.pmc	Wed Jan  7 09:13:27 2009
@@ -923,8 +923,21 @@
             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                 "Unknown introspection value '%S'", what);
 
-        /* Clone and return. */
-        return PMC_IS_NULL(found) ? PMCNULL : VTABLE_clone(interp, found);
+        /* return found value */
+        if (PMC_IS_NULL(found)) { return PMCNULL; }
+        if (found->vtable->base_type == enum_class_Hash) {
+            /* for Hash return values, create and return a shallow 
+             * clone because the VTABLE_clone does a deep clone */
+            PMC * const hash = pmc_new(interp, enum_class_Hash);
+            PMC * const iter = VTABLE_get_iter(interp, found);
+            while (VTABLE_get_bool(interp, iter)) {
+                STRING * key = VTABLE_shift_string(interp, iter);
+                PMC * value  = VTABLE_get_pmc_keyed_str(interp, found, key);
+                VTABLE_set_pmc_keyed_str(interp, hash, key, value);
+            }
+            return hash;
+        }
+        return VTABLE_clone(interp, found);
     }
 
 /*



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About