~ubuntu-branches/ubuntu/vivid/nqp/vivid-proposed

« back to all changes in this revision

Viewing changes to src/vm/parrot/NQP/Ops.nqp

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini
  • Date: 2013-11-01 12:09:18 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20131101120918-kx51sl0sxl3exsxi
Tags: 2013.10-1
* New upstream release
* Bump versioned (Build-)Depends on parrot
* Update patches
* Install new README.pod
* Fix vcs-field-not-canonical
* Do not install rubyish examples
* Do not Depends on parrot-devel anymore
* Add 07_disable-serialization-tests.patch

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
my $ops := QAST::Compiler.operations();
 
2
 
 
3
$ops.add_hll_op('nqp', 'preinc', -> $qastcomp, $op {
 
4
    my $var := $op[0];
 
5
    unless nqp::istype($var, QAST::Var) {
 
6
        nqp::die("Pre-increment can only work on a variable");
 
7
    }
 
8
    $qastcomp.as_post(QAST::Op.new(
 
9
        :op('bind'),
 
10
        $var,
 
11
        QAST::Op.new(
 
12
            :op('add_n'),
 
13
            $var,
 
14
            QAST::IVal.new( :value(1) )
 
15
        )));
 
16
});
 
17
 
 
18
$ops.add_hll_op('nqp', 'predec', -> $qastcomp, $op {
 
19
    my $var := $op[0];
 
20
    unless nqp::istype($var, QAST::Var) {
 
21
        nqp::die("Pre-decrement can only work on a variable");
 
22
    }
 
23
    $qastcomp.as_post(QAST::Op.new(
 
24
        :op('bind'),
 
25
        $var,
 
26
        QAST::Op.new(
 
27
            :op('sub_n'),
 
28
            $var,
 
29
            QAST::IVal.new( :value(1) )
 
30
        )));
 
31
});
 
32
 
 
33
$ops.add_hll_op('nqp', 'postinc', -> $qastcomp, $op {
 
34
    my $var := $op[0];
 
35
    my $tmp := QAST::Op.unique('tmp');
 
36
    unless nqp::istype($var, QAST::Var) {
 
37
        nqp::die("Post-increment can only work on a variable");
 
38
    }
 
39
    $qastcomp.as_post(QAST::Stmt.new(
 
40
        :resultchild(0),
 
41
        QAST::Op.new(
 
42
            :op('bind'),
 
43
            QAST::Var.new( :name($tmp), :scope('local'), :decl('var'), :returns($var.returns) ),
 
44
            $var
 
45
        ),
 
46
        QAST::Op.new(
 
47
            :op('bind'),
 
48
            $var,
 
49
            QAST::Op.new(
 
50
                :op('add_n'),
 
51
                QAST::Var.new( :name($tmp), :scope('local'), :returns($var.returns)  ),
 
52
                QAST::IVal.new( :value(1) )
 
53
            )
 
54
        )));
 
55
});
 
56
 
 
57
$ops.add_hll_op('nqp', 'postdec', -> $qastcomp, $op {
 
58
    my $var := $op[0];
 
59
    my $tmp := QAST::Op.unique('tmp');
 
60
    unless nqp::istype($var, QAST::Var) {
 
61
        nqp::die("Post-decrement can only work on a variable");
 
62
    }
 
63
    $qastcomp.as_post(QAST::Stmt.new(
 
64
        :resultchild(0),
 
65
        QAST::Op.new(
 
66
            :op('bind'),
 
67
            QAST::Var.new( :name($tmp), :scope('local'), :decl('var') ),
 
68
            $var
 
69
        ),
 
70
        QAST::Op.new(
 
71
            :op('bind'),
 
72
            $var,
 
73
            QAST::Op.new(
 
74
                :op('sub_n'),
 
75
                QAST::Var.new( :name($tmp), :scope('local') ),
 
76
                QAST::IVal.new( :value(1) )
 
77
            )
 
78
        )));
 
79
});
 
80
 
 
81
$ops.add_hll_op('nqp', 'numify', -> $qastcomp, $op {
 
82
    $qastcomp.as_post($op[0], :want('n'))
 
83
});
 
84
 
 
85
$ops.add_hll_op('nqp', 'stringify', -> $qastcomp, $op {
 
86
    $qastcomp.as_post($op[0], :want('s'))
 
87
});
 
88
 
 
89
$ops.add_hll_op('nqp', 'falsey', -> $qastcomp, $op {
 
90
    my $res := $*REGALLOC.fresh_i();
 
91
    my $ops := PIRT::Ops.new(:result($res));
 
92
    my $arg_post := $qastcomp.as_post($op[0]);
 
93
    if nqp::lc($qastcomp.infer_type($arg_post.result)) eq 'i' {
 
94
        $ops.push($arg_post);
 
95
        $ops.push_pirop('not', $res, $arg_post);
 
96
    }
 
97
    else {
 
98
        $arg_post := $qastcomp.coerce($arg_post, 'P');
 
99
        $ops.push($arg_post);
 
100
        $ops.push_pirop('isfalse', $res, $arg_post);
 
101
    }
 
102
    $ops
 
103
});