Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Implement box/unbox. 
Includes the HLL override support, plus some default HLL-less handling
that just calls box/unbox ops with boot types.
  • Loading branch information
@jnthn
jnthn committed Jan 12, 2013
1 parent 68630b7 commit 43ac52b
Showing 1 changed file with 98 additions and 3 deletions.
101 changes: 98 additions & 3 deletions lib/QAST/JASTCompiler.nqp
View file
Expand Up @@ -109,6 +109,10 @@ class QAST::OperationsJAST {
# Hash of hash of code.
my %hll_ops;

# Mapping of how to box/unbox by HLL.
my %hll_box;
my %hll_unbox;

# What we know about inlinability.
my %core_inlinability;
my %hll_inlinability;
Expand Down Expand Up @@ -232,6 +236,34 @@ class QAST::OperationsJAST {
result($il, $stack_out)
}
}

# Adds a HLL box handler.
method add_hll_box($hll, $type, $handler) {
unless $type == $RT_INT || $type == $RT_NUM || $type == $RT_STR {
nqp::die("Unknown box type '$type'");
}
%hll_box{$hll} := {} unless nqp::existskey(%hll_box, $hll);
%hll_box{$hll}{$type} := $handler;
}

# Adds a HLL unbox handler.
method add_hll_unbox($hll, $type, $handler) {
unless $type == $RT_INT || $type == $RT_NUM || $type == $RT_STR {
nqp::die("Unknown unbox type '$type'");
}
%hll_unbox{$hll} := {} unless nqp::existskey(%hll_unbox, $hll);
%hll_unbox{$hll}{$type} := $handler;
}

# Generates instructions to box what's currently on the stack top.
method box($qastcomp, $hll, $type) {
%hll_box{$hll}{$type}($qastcomp)
}

# Generates instructions to unbox what's currently on the stack top.
method unbox($qastcomp, $hll, $type) {
%hll_unbox{$hll}{$type}($qastcomp)
}
}

# Set of sequential statements
Expand Down Expand Up @@ -931,6 +963,59 @@ QAST::OperationsJAST.add_core_op('bind', -> $qastcomp, $op {
$qastcomp.as_jast(@children[0])
});

# Default ways to box/unbox (for no particular HLL).
QAST::OperationsJAST.add_hll_box('', $RT_INT, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bootint', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'box_i', $TYPE_SMO, 'Long', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_box('', $RT_NUM, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bootnum', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'box_n', $TYPE_SMO, 'Double', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_box('', $RT_STR, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bootstr', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'box_s', $TYPE_SMO, $TYPE_STR, $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_unbox('', $RT_INT, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'unbox_i', 'Long', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_unbox('', $RT_NUM, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'unbox_n', 'Double', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_unbox('', $RT_STR, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'unbox_s', $TYPE_STR, $TYPE_SMO, $TYPE_TC ));
$il
});

# Arithmetic ops
QAST::OperationsJAST.map_jvm_core_op('add_i', 'ladd', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_jvm_core_op('add_n', 'dadd', [$RT_NUM, $RT_NUM], $RT_NUM);
Expand Down Expand Up @@ -2108,6 +2193,16 @@ class QAST::CompilerJAST {
elsif $desired == $RT_VOID {
$il.append(pop_ins($got));
}
elsif $desired == $RT_OBJ {
my $hll := '';
try $hll := $*HLL;
return QAST::OperationsJAST.box(self, $hll, $got);
}
elsif $got == $RT_OBJ {
my $hll := '';
try $hll := $*HLL;
return QAST::OperationsJAST.unbox(self, $hll, $desired);
}
elsif $desired == $RT_INT {
if $got == $RT_NUM {
$il.append(JAST::Instruction.new( :op('d2l') ));
Expand All @@ -2117,7 +2212,7 @@ class QAST::CompilerJAST {
$TYPE_OPS, 'coerce_s2i', 'Long', $TYPE_STR ));
}
else {
nqp::die("Auto-unboxing NYI");
nqp::die("Unknown coercion case for int");
}
}
elsif $desired == $RT_NUM {
Expand All @@ -2129,7 +2224,7 @@ class QAST::CompilerJAST {
$TYPE_OPS, 'coerce_s2n', 'Double', $TYPE_STR ));
}
else {
nqp::die("Auto-unboxing NYI");
nqp::die("Unknown coercion case for num");
}
}
elsif $desired == $RT_STR {
Expand All @@ -2142,7 +2237,7 @@ class QAST::CompilerJAST {
$TYPE_OPS, 'coerce_n2s', $TYPE_STR, 'Double' ));
}
else {
nqp::die("Auto-unboxing NYI");
nqp::die("Unknown coercion case for str");
}
}
else {
Expand Down

0 comments on commit 43ac52b

Please sign in to comment.