Project: Rakudo

Revision: 30750

Author: pmichaud

Date: 04 Sep 2008 10:03:16

• /trunk/languages/perl6/src/parser/actions.pm

  ......	@@ -3035,71 +3035,32 @@
  3035	3035	}
  3036	3036
  3037	3037
  3038		# Get's the :immediate setup sub for a block; if it doesn't have one, adds it.
  3039		sub get_block_setup_sub($block) {
  3040		my $init := $block[0];
  3041		my $found;
  3042		for @($init) {
  3043		if $_.WHAT() eq 'Block' && $_.pirflags() eq ':immediate' {
  3044		$found := $_;
  3045		}
  3046		}
  3047		unless $found {
  3048		$found := PAST::Block.new(
  3049		:blocktype('declaration'),
  3050		:pirflags(':immediate'),
  3051
  3052		# For block type; defaults to Block
  3053		PAST::Stmts.new(
  3054		PAST::Op.new(
  3055		:inline(
  3056		' .local pmc desc',
  3057		' $P0 = interpinfo .INTERPINFO_CURRENT_SUB',
  3058		' $P0 = $P0."get_outer"()',
  3059		' setprop $P0, "$!proto", %0'
  3060		),
  3061		PAST::Var.new(
  3062		:name('Block'),
  3063		:scope('package')
  3064		)
  3065		)
  3066		),
  3067
  3068		# For signature setup - default to empty signature object.
  3069		PAST::Stmts.new(
  3070		PAST::Op.new(
  3071		:inline(' setprop $P0, "$!signature", %0'),
  3072		PAST::Op.new(
  3073		:pasttype('callmethod'),
  3074		:name('!create'),
  3075		PAST::Var.new(
  3076		:name('Signature'),
  3077		:scope('package'),
  3078		:namespace(list())
  3079		)
  3080		)
  3081		)
  3082		)
  3083		);
  3084		$init.push($found);
  3085		}
  3086		$found
  3087		}
  3088
  3089
  3090	3038	# Set the proto object type of a block.
  3091	3039	sub set_block_proto($block, $type) {
  3092		my $setup_sub := get_block_setup_sub($block);
  3093		$setup_sub[0][0][0].name($type);
  	3040	my $loadinit := $block.loadinit();
  	3041	$loadinit.push(
  	3042	PAST::Op.new(
  	3043	:inline('setprop %0, "$!proto", %1'),
  	3044	PAST::Var.new( :name('block'), :scope('register') ),
  	3045	PAST::Var.new( :name($type), :scope('package') )
  	3046	)
  	3047	);
  3094	3048	}
  3095	3049
  3096	3050
  3097	3051	# Associate a signature object with a block.
  3098	3052	sub set_block_sig($block, $sig_obj) {
  3099		my $setup_sub := get_block_setup_sub($block);
  3100		$setup_sub[1][0][0] := $sig_obj;
  	3053	my $loadinit := $block.loadinit();
  	3054	$loadinit.push(
  	3055	PAST::Op.new(
  	3056	:inline('setprop %0, "$!signature", %1'),
  	3057	PAST::Var.new( :name('block'), :scope('register') ),
  	3058	$sig_obj
  	3059	)
  	3060	);
  3101	3061	}
  3102	3062
  	3063
  3103	3064	# Creates a signature descriptor (for now, just a hash).
  3104	3065	sub sig_descriptor_create() {
  3105	3066	PAST::Stmts.new(