Skip to content
Browse files

Merge pull request #4 from andreoss/master

Make yapsi work
  • Loading branch information...
2 parents cfdf7e3 + 7b8792d commit a8617b6dd7efa8df58aac57435f4e43969dce4ea @masak committed Nov 9, 2015
Showing with 40 additions and 44 deletions.
  1. +26 −34 bin/yapsi
  2. +12 −8 lib/Yapsi.pm
  3. +1 −1 t/compiler.t
  4. +1 −1 t/runtime.t
View
60 bin/yapsi
@@ -1,58 +1,50 @@
#!/usr/bin/env perl6
use v6;
-
use Yapsi;
-my @TARGETS = <run future sic>;
+constant @TARGETS = <run future sic>;
sub run-code($program, :$target) {
+ state Yapsi::Compiler $compiler .= new;
+ state Yapsi::Runtime $runtime .= new;
+
try {
- my @output;
- given Yapsi::Compiler.new {
- @output = $target eq 'future'
- ?? .to-future($program)
- !! .compile($program);
- warn $_ for .warnings;
- }
-
+ my @output = $target eq 'future'
+ ?? $compiler.to-future($program)
+ !! $compiler.compile($program);
+ warn $_ for $compiler.warnings;
+
if $target eq 'run' {
- my Yapsi::Runtime $runtime .= new;
$runtime.run(@output);
}
else {
.say for @output;
}
+ CATCH {
+ default {
+ say $_;
+ }
+ }
}
- say $! if $!;
}
-if @*ARGS && @*ARGS[0] eq '--version' {
- my $revision = qx[git describe];
- say "This is Yapsi, revision $revision";
- shift @*ARGS;
+multi MAIN( Str $file-name
+ , Str :$target = 'run') {
+ run-code $file-name.IO.slurp, :$target;
}
-my $target = 'run';
-if @*ARGS && @*ARGS[0] ~~ /'--target='(\w+)/ {
- die "Recognized targets: {@TARGETS}"
- unless $0.lc eq any @TARGETS;
- $target = $0.lc;
- shift @*ARGS;
+multi MAIN( Str :e($programm)!
+ , Str :$target = 'run') {
+
+ run-code $programm, :$target;
}
-if @*ARGS == 2 && @*ARGS[0] eq '-e' {
- run-code(@*ARGS[1], :$target);
-}
-elsif @*ARGS == 1 {
- run-code(slurp(@*ARGS[0]), :$target);
-}
-elsif @*ARGS == 0 {
- while prompt(">>> ") -> $program {
+multi MAIN(Str :$target = 'run') {
+ while defined my $program = prompt('>>> ') {
run-code($program, :$target);
}
- say '';
}
-else {
- die
- "Usage: `$*PROGRAM_NAME \[<file>\]` or `$*PROGRAM_NAME -e '<program>'`";
+
+sub USAGE {
+ say "Usage: $*PROGRAM-NAME [--target=<@TARGETS[]>] [-e=<expression>] <file-name>"
}
View
20 lib/Yapsi.pm
@@ -75,7 +75,7 @@ class FUTURE::Node {
has FUTURE::Node @.children is rw;
method push(*@nodes) {
- @!children.push(|@nodes);
+ @!children.append: @nodes;
return self;
}
@@ -87,7 +87,8 @@ class FUTURE::Node {
sub helper($node, $index) {
take [~] ' ' x $index,
$node.WHAT.perl.subst(/^ .*? '::'/, ''),
- $node.?info;
+ $node.?info || '';
+
helper($_, $index + 1) for $node.?children;
}
@@ -185,7 +186,7 @@ class Yapsi::Perl6::Actions {
my $block = @blockstack.pop;
my $name = $block.name;
$block.vars = @vars.list;
- $block.children.push($<statementlist><statement>».ast.grep(*.defined));
+ $block.children.append: $<statementlist><statement>».ast.grep(*.defined);
make $block;
if @blockstack {
%block-parents{$name} = @blockstack[*-1];
@@ -224,7 +225,7 @@ class Yapsi::Perl6::Actions {
method statement_control_if($/) {
make FUTURE::If.new(:children($<expression>.ast,
$<block>.ast,
- $<else>[0].?ast));
+ $<else>.?ast));
}
method statement_control_unless($/) {
@@ -688,7 +689,7 @@ class Yapsi::Runtime {
die "SIC is $0 but this is $VERSION -- cannot run";
}
- my @registers-stack = [];
+ my @registers-stack = [[],];
my @ip-stack;
sub reg() { @registers-stack[@registers-stack - 1] }
@@ -706,8 +707,11 @@ class Yapsi::Runtime {
# RAKUDO: Some Any()s seem to end up in the @sic array. Hence the
# need for prefix:<~>. Would be interesting to learn where
# this happens.
- while ~@sic[++$line]
- ~~ / ' `' (\S*) :s \'(<-[']>+)\' ( ':'\w+)* / {
+ while @sic[++$line] {
+ next unless @sic[$line] ~~ /
+ \c[GRAVE ACCENT] (\S*) \s* \' ~ \' (<-[']>+) \s* (':'\w+)*
+ /;
+
given $0 {
when "var" {
push @vars, ~$1;
@@ -817,7 +821,7 @@ class Yapsi::Runtime {
}
}
pop @registers-stack;
- $ip = pop @ip-stack;
+ $ip = @ip-stack && @ip-stack.pop ;
$!current-lexpad.=outer;
}
}
View
2 t/compiler.t
@@ -92,4 +92,4 @@ for @programs-that-don't-compile -> $pair { # '
"'{escape $program}' gives error '$expected-error'";
}
-done;
+done-testing;
View
2 t/runtime.t
@@ -65,4 +65,4 @@ for @tests -> $program, $expected, $message {
is $out, $expected, $message;
}
-done;
+done-testing;

0 comments on commit a8617b6

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