Permalink
Browse files

Take a first crack at implementing constant folding

Using the 'pure' trait on functions, a function call with only immutable
constant arguments can be replaced with its result value.  For now only
works on true functions; some pieces of function-like syntax that are
implemented differently don't fold.
  • Loading branch information...
sorear committed Jan 9, 2012
1 parent 25c122b commit eba5eb328cac03285a5ec71f8b736294c2d8c41b
Showing with 145 additions and 9 deletions.
  1. +3 −2 lib/CORE.setting
  2. +48 −1 lib/CodeGen.cs
  3. +1 −1 lib/Kernel.cs
  4. +2 −0 lib/Serialize.cs
  5. +8 −3 src/CompilerBlob.cs
  6. +7 −1 src/NieczaBackendDotnet.pm6
  7. +20 −0 src/NieczaPassSimplifier.pm6
  8. +55 −0 src/niecza
  9. +1 −1 test.pl
View
@@ -70,7 +70,8 @@ sub any (*@p) is pure { any @p }
sub infix:<< == >>($l,$r) is pure is Niecza::builtin('numeq',2,2)
is Niecza::absprec<m=> is assoc<chain> { $l == $r }
-sub infix:<< != >>($l,$r) is pure is Niecza::builtin('numne',2,2)
+# Needs special handling of junctions
+sub infix:<< != >>(\$l,\$r) is pure is Niecza::builtin('numne',2,2)
is equiv<==> { $l != $r }
sub infix:<< < >>($l,$r) is pure is Niecza::builtin('numlt',2,2)
is equiv<==> { $l < $r }
@@ -2339,7 +2340,7 @@ sub infix:<?&> is Niecza::absprec<u=> is pure ($a, $b) { ?($a && $b) }
sub infix:<?|> ($a, $b) is pure { ?($a || $b) }
sub infix:<?^> ($a, $b) is pure { ?( +$a +^ $b ) }
sub prefix:<?^> ($a) is pure { !$a }
-sub prefix:<|> (\$item) is pure { $item.Capture }
+sub prefix:<|> (\$item) { $item.Capture } # marking this pure breaks syntax
sub prefix:<^> ($limit) is pure { 0 ..^ +$limit }
sub prefix:<so> is Niecza::absprec<h=> is pure (\$item) { ?$item }
sub infix:<xx> is Niecza::absprec<s=> (\$list, $ct) { map { $list }, ($ct ~~ Whatever) ?? ^Inf !! ^$ct }
View
@@ -2768,6 +2768,9 @@ class NamProcessor {
};
handlers["const"] = delegate(NamProcessor th, object[] z) {
object[] ch = z[1] as object[];
+ if (ch == null) {
+ return th.cpb.eu.RefConstant("", "", z[1], null);
+ }
string chh = JScalar.S(ch[0]);
if (chh == "exactnum") {
return th.cpb.eu.VarConstExact(JScalar.I(ch[1]),
@@ -3598,6 +3601,7 @@ public class DowncallReceiver : CallReceiver {
StringBuilder sb = new StringBuilder();
foreach(object a in args) {
char ch = (a is int) ? 'i' : (a is Handle) ? 'h' :
+ (a is double) ? 'd' :
(a is string) ? 's' : (a is bool) ? 'b' :
(a == null) ? 'n' : 'X';
sb.AppendFormat("{0}:{1}; ", ch, a);
@@ -3634,7 +3638,8 @@ public class DowncallReceiver : CallReceiver {
object o = Handle.Unbox(args[1]);
return (o is SubInfo) ? "sub" : (o is RuntimeUnit) ? "unit" :
(o is STable) ? "type" : (o is Frame) ? "frame" :
- (o is Parameter) ? "param" : "unknown";
+ (o is Variable) ? "value" : (o is Parameter) ? "param" :
+ "unknown";
}
public static object set_binding(object[] args) {
if (Environment.GetEnvironmentVariable("NIECZA_DEFER_TRACE") != null) {
@@ -3767,6 +3772,48 @@ public class DowncallReceiver : CallReceiver {
((SubInfo)Handle.Unbox(args[1])).SetInlined();
return null;
}
+ public static object value_starts_with_pair(object[] args) {
+ var ob = ((Variable)Handle.Unbox(args[1])).Fetch();
+ if (ob.Isa(Kernel.PairMO))
+ return true;
+ if (ob.Isa(Kernel.ParcelMO) && Kernel.UnboxAny<Variable[]>(ob)[0].Fetch().Isa(Kernel.PairMO))
+ return true;
+ return false;
+ }
+ public static object unit_constant_fold(object[] args) {
+ var callee = (SubInfo)Handle.Unbox(args[2]);
+ var pos = new List<Variable>();
+ var nam = new VarHash();
+
+ for (int ix = 3; ix < args.Length; ix += 2) {
+ var v = (Variable)Handle.Unbox(args[ix+1]);
+ if (args[ix] == null) {
+ pos.Add(v);
+ } else {
+ nam[(string)args[ix]] = v;
+ }
+ }
+
+ object r = null;
+ try {
+ r = Handle.Wrap(Kernel.RunInferior(callee.protosub.Invoke(
+ Kernel.GetInferiorRoot(), pos.ToArray(), nam)));
+ } catch (Exception) { }
+ return r;
+ }
+ public static object unit_string_constant(object[] args) {
+ return Handle.Wrap(Builtins.MakeStr((string)args[2]));
+ }
+ public static object unit_numeric_constant(object[] args) {
+ if (args.Length == 4) {
+ int bas = (int)args[2];
+ string digits = (string)args[3];
+ return Handle.Wrap(EmitUnit.ExactNum(bas, digits));
+ } else {
+ double d = (args[2] is double) ? (double)args[2] : (int)args[2];
+ return Handle.Wrap(Builtins.MakeFloat(d));
+ }
+ }
public static object sub_run_BEGIN_CC(object[] args) {
SubInfo si = (SubInfo)Handle.Unbox(args[1]);
Variable v = si.RunBEGIN();
View
@@ -532,7 +532,7 @@ sealed class EmitUnit {
return ValConstant(new string(c), Builtins.MakeFloat(n));
}
- public Variable ExactNum(int numbase, string digits) {
+ public static Variable ExactNum(int numbase, string digits) {
BigInteger num = BigInteger.Zero;
BigInteger den = BigInteger.Zero;
View
@@ -431,6 +431,7 @@ public class FreezeBuffer {
null, typeof(Rat), typeof(FatRat), typeof(Complex),
typeof(double), typeof(int), typeof(string), typeof(VarHash),
typeof(Variable[]), typeof(VarDeque), typeof(STable),
+ typeof(BigInteger),
};
[Immutable]
internal static Func<P6opaque>[] boxCreate = new Func<P6opaque>[] {
@@ -439,6 +440,7 @@ public class FreezeBuffer {
BoxObject<int>.Create, BoxObject<string>.Create,
BoxObject<VarHash>.Create, BoxObject<Variable[]>.Create,
BoxObject<VarDeque>.Create, BoxObject<STable>.Create,
+ BoxObject<BigInteger>.Create,
};
[Immutable]
static Type[] anyTypes = new Type[] {
View
@@ -48,7 +48,7 @@ public class UpcallReceiver : CallReceiver {
public class Downcaller {
internal static Variable upcall_cb;
static IDictionary responder;
- static P6any UnitP, StaticSubP, TypeP, ParamP;
+ static P6any UnitP, StaticSubP, TypeP, ParamP, ValueP;
static string obj_dir;
// let the CLR load assemblies from obj/ too
@@ -64,13 +64,14 @@ public class Downcaller {
}
// Better, but still fudgy. Relies too much on path structure.
public static void InitSlave(Variable cb, Variable unit,
- Variable staticSub, Variable type, Variable param) {
+ Variable staticSub, Variable type, Variable param, Variable value) {
if (responder != null) return;
UnitP = unit.Fetch();
StaticSubP = staticSub.Fetch();
TypeP = type.Fetch();
ParamP = param.Fetch();
+ ValueP = value.Fetch();
obj_dir = Path.GetFullPath(Path.Combine(
AppDomain.CurrentDomain.BaseDirectory,
@@ -95,7 +96,10 @@ public class Downcaller {
return (string) o.mo.mro_raw_Str.Get(v);
else if (o.Isa(Kernel.BoolMO))
return (bool) o.mo.mro_raw_Bool.Get(v);
- else if (o.Isa(Kernel.ListMO)) {
+ else if (o.Isa(Kernel.NumMO)) {
+ double d = Kernel.UnboxAny<double>(o);
+ return ((d % 1) == 0) ? (object)(int)d : (object)d;
+ } else if (o.Isa(Kernel.ListMO)) {
VarDeque it = o.mo.mro_raw_iterator.Get(v);
var lo = new List<object>();
while (Kernel.IterHasFlat(it, true))
@@ -133,6 +137,7 @@ public class Downcaller {
P6any pr = (t == "type") ? TypeP :
(t == "sub") ? StaticSubP :
(t == "param") ? ParamP :
+ (t == "value") ? ValueP :
(t == "unit") ? UnitP : Kernel.AnyP;
return Kernel.BoxAnyMO(r, pr.mo);
}
@@ -61,10 +61,11 @@ class Param { ... }
class Unit { ... }
class StaticSub { ... }
class Type { ... }
+class Value { ... }
method new(*%_) {
my $self = callsame;
- Q:CgOp { (rnull (rawscall Niecza.Downcaller,CompilerBlob.InitSlave {&upcalled} {Unit} {StaticSub} {Type} {Param})) };
+ Q:CgOp { (rnull (rawscall Niecza.Downcaller,CompilerBlob.InitSlave {&upcalled} {Unit} {StaticSub} {Type} {Param} {Value})) };
downcall("safemode") if $self.safemode;
$self;
}
@@ -96,6 +97,11 @@ class Param {
method FALLBACK($name, *@args) { downcall("param_$name", self, @args) }
}
+class Value {
+ method kind { "value" }
+ method FALLBACK($name, *@args) { downcall("value_$name", self, @args) }
+}
+
class StaticSub {
method kind { "sub" }
method FALLBACK($name, *@args) { downcall("sub_$name", self, @args) }
@@ -121,6 +121,22 @@ sub do_atpos($body, $nv, $invname, $op) { #OK not used
return ::Op::Builtin.new(name => 'at_pos', args => $args);
}
+# XXX should support folding of SimplePair, SimpleParcel too
+sub check_folding($sub, $op) {
+ my @evargs;
+ for $op.getargs -> $aop {
+ my $name;
+ if $aop.^isa(::Op::SimplePair) {
+ $name = $aop.key;
+ $aop := $aop.value;
+ }
+ push @evargs, $name, ($aop.const_value // return);
+ }
+
+ my $ret = $*unit.constant_fold($sub, @evargs) // return;
+ ::Op::GeneralConst.new(value => $ret);
+}
+
sub run_optree($body, $op, $nv) {
die "WTF in $body.name()" if !defined $op;
my @kids := flat($op.ctxzyg($nv));
@@ -141,6 +157,10 @@ sub run_optree($body, $op, $nv) {
@inv_lex[4].has_lexical($invname ~ ':(!proto)');
return $op unless @inv_lex[0] eq 'sub';
+ if @inv_lex[4].get_extend('pure') {
+ if check_folding(@inv_lex[4], $op) -> $nop { return $nop }
+ }
+
if @inv_lex[4].get_extend('builtin') -> $B {
return $op unless defined my $args = no_named_params($op);
return $op unless $args >= $B[1] &&
View
@@ -25,6 +25,32 @@ use STD;
# }
# }
+augment class Op {
+method const_value() { }
+}
+
+augment class Op::StatementList {
+ method const_value() { $!children[0].const_value if $!children == 1 }
+}
+
+augment class Op::Paren {
+ method const_value() { $!inside.const_value }
+}
+
+augment class Op::StringLiteral {
+ method const_value() { $*unit.string_constant(~$!text) }
+}
+
+augment class Op::Num {
+ method const_value() { $*unit.numeric_constant(@($!value)) }
+}
+
+class Op::GeneralConst is Op {
+ has $.value;
+ method const_value() { $!value }
+ method code($) { CgOp.const($!value) }
+}
+
my constant %item_assignment = (:dba('item assignment') , :prec<i=>, :assoc<right>, :!pure);
augment grammar STD::P6 {
rule post_constraint {
@@ -42,6 +68,7 @@ augment grammar STD::P6 {
class Operator::Mixin is Operator::Function {
method with_args($/, *@args) {
if @args[1] ~~ ::Op::CallSub {
+ nextsame if @args[1].invocant ~~ ::Op::Lexical && @args[1].invocant.name eq '&_param_role_inst';
$/.CURSOR.sorry("Can only provide exactly one initial value to a mixin") unless @args[1].getargs.elems == 1;
::Op::CallSub.new(|node($/), invocant => $.function,
args => [@args[0], @args[1].invocant, ::Op::SimplePair.new(
@@ -53,6 +80,33 @@ class Operator::Mixin is Operator::Function {
}
augment class NieczaActions {
+method check_hash($/) {
+ my $do = $<pblock><blockoid>.ast;
+
+ return False unless $do.^isa(::Op::StatementList);
+ return True if $do.children == 0;
+ return False if $do.children > 1;
+
+ $do = $do.children[0];
+ my @bits = $do.^isa(::Op::SimpleParcel) ?? @( $do.items ) !! $do;
+
+ return True if @bits[0].^isa(::Op::SimplePair);
+
+ if @bits[0].^isa(::Op::Builtin) && @bits[0].name eq 'pair' {
+ return True;
+ }
+
+ if @bits[0].^isa(::Op::GeneralConst) && @bits[0].value.starts_with_pair {
+ return True;
+ }
+
+ if @bits[0].^isa(::Op::Lexical) && substr(@bits[0].name,0,1) eq '%' {
+ return True;
+ }
+
+ return False;
+}
+
method process_block_traits($/, @tr) {
my $sub = $*CURLEX<!sub>;
my $pack = $sub.body_of;
@@ -96,6 +150,7 @@ method process_block_traits($/, @tr) {
} elsif !$pack && $tr<nobinder> {
$sub.set_signature(Any);
} elsif !$pack && $tr<pure> {
+ $sub.outer.create_static_pad;
$sub.set_extend('pure', True);
} elsif !$pack && grep { defined $tr{$_} }, <looser tighter equiv> {
my $rel = $tr.keys.[0];
View
@@ -2278,7 +2278,7 @@
is ((1 | 3) + 1).perl, 'any(2, 4)', '+ autothreads any';
is (1 == (1 | 3)).perl, 'any(Bool::True, Bool::False)', '== autothreads';
-is (4 & 9).sqrt.perl, 'all(2, 3)', '.sqrt autothreads';
+is (4 & 9).sqrt.perl, 'all(2e0, 3e0)', '.sqrt autothreads';
is (4 & 9).Bool.perl, 'Bool::True', '.Bool does not autothread';
is (40 & 90).substr(0,1).perl, 'all("4", "9")', '.substr with arguments autothreads';
is ((2 | 4) + (1 & 2)).perl, 'all(any(3, 5), any(4, 6))',

0 comments on commit eba5eb3

Please sign in to comment.