Skip to content
Browse files

[cardinal]

* implement BEGIN and END blocks. 
* stolen from rakudo.

git-svn-id: https://svn.parrot.org/parrot/trunk/languages/cardinal@25496 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 314cc1b commit 51837928b6541d98c3eb8bcc8a7c555d34aca5a3 @kjs kjs committed
Showing with 59 additions and 0 deletions.
  1. +30 −0 cardinal.pir
  2. +18 −0 src/parser/actions.pm
  3. +11 −0 src/parser/grammar.pg
View
30 cardinal.pir
@@ -21,6 +21,18 @@ object.
=cut
+
+.namespace
+
+.sub 'onload' :anon :load :init
+ $P0 = subclass 'ResizablePMCArray', 'List'
+.end
+
+.namespace [ 'List' ]
+
+
+
+
.namespace [ 'cardinal::Compiler' ]
.loadlib 'cardinal_group'
@@ -33,6 +45,10 @@ object.
$P1.'language'('cardinal')
$P1.'parsegrammar'('cardinal::Grammar')
$P1.'parseactions'('cardinal::Grammar::Actions')
+
+ ## create a list of END blocks to be run
+ $P0 = new 'List'
+ set_hll_global ['cardinal'], '@?END_BLOCKS', $P0
.end
=item main(args :slurpy) :main
@@ -47,6 +63,18 @@ to the cardinal compiler.
$P0 = compreg 'cardinal'
$P1 = $P0.'command_line'(args)
+
+ .include 'iterator.pasm'
+ .local pmc iter
+ $P0 = get_hll_global ['cardinal'], '@?END_BLOCKS'
+ iter = new 'Iterator', $P0
+ iter = .ITERATE_FROM_END
+ iter_loop:
+ unless iter goto iter_end
+ $P0 = pop iter
+ $P0()
+ goto iter_loop
+ iter_end:
.end
@@ -54,6 +82,8 @@ to the cardinal compiler.
.include 'src/gen_grammar.pir'
.include 'src/gen_actions.pir'
+
+
=back
=cut
View
18 src/parser/actions.pm
@@ -78,6 +78,24 @@ method alias($/) {
make PAST::Op.new( $alias, $fname, :pasttype('bind'), :node($/) );
}
+method begin($/) {
+ my $past := $( $<comp_stmt> );
+ my $sub := PAST::Compiler.compile( $past );
+ $sub();
+ ## XXX what to do here? empty block? stolen from rakudo.
+ make PAST::Block.new( :node($/) );
+}
+
+method end($/) {
+ my $past := PAST::Block.new( $( $<comp_stmt> ), :node($/) );
+ $past.blocktype('declaration');
+ my $sub := PAST::Compiler.compile( $past );
+ PIR q< $P0 = get_hll_global ['cardinal'], '@?END_BLOCKS' >;
+ PIR q< $P1 = find_lex '$sub' >;
+ PIR q< push $P0, $P1 >;
+ make $past;
+}
+
method assignment($/) {
my $lhs := $( $<mlhs> );
my $rhs := $( $<mrhs> );
View
11 src/parser/grammar.pg
@@ -33,6 +33,8 @@ rule term { \n | ';' }
rule basic_stmt {
| <alias> {*} #= alias
| <expr> {*} #= expr
+ | <begin> {*} #= begin
+ | <end> {*} #= end
}
rule alias {
@@ -62,6 +64,15 @@ rule not_expr {
{*}
}
+rule begin {
+ 'BEGIN' '{' <comp_stmt> '}'
+ {*}
+}
+
+rule end {
+ 'END' '{' <comp_stmt> '}'
+ {*}
+}
rule assignment {
<mlhs> '=' <mrhs>

0 comments on commit 5183792

Please sign in to comment.
Something went wrong with that request. Please try again.