## run-optional-nextcode-improvers-g.pkg -- Execute optional optimizations per config variable cg::optional_nextcode_improvers
#
# NB: Despite our name, we always run
#
# rup::replace_unlimited_precision_int_ops_in_nextcode
#
# before returning.
#
# Currently available code improvers ("optimizers") are:
#
# first_contract
# eta
# uncurry
# split_known_escaping_functions
# last_contract
# cycle_expand
# contract
# flatten
# zeroexpand
# expand
# print
#
# The default setting of cg::optional_nextcode_improvers is:
#
# ["zeroexpand", "last_contract"]
# Compiled by:
# src/lib/compiler/core.sublib# This file is a driver which executes optional
# optimizations in the order specified by the
#
# cg::optional_nextcode_improvers
#
# configuration parameter. For the default value of this parameter
# (currently ["zeroexpand", "last_contract"]) see
#
# src/lib/compiler/toplevel/main/compiler-controls.pkg#
# or at the Linux commandline do
#
# linux$ my
# eval: show_control "cg::optional_nextcode_improvers";
#
# You can set this parameter via (say)
# eval: set_control "cg::optional_nextcode_improvers" "zeroexpand, uncurry, last_contract";
#
#
# We get invoked from the
#
# src/lib/compiler/back/top/main/backend-tophalf-g.pkg#
# function
#
# translate_anormcode_to_execode()
#
# which uses us in the transform sequence
#
# translate_anormcode_to_nextcode()
# nextcode_preimprover_transform()
# optional_nextcode_improvers()
#
# For context, see the comments in
#
# src/lib/compiler/back/top/highcode/highcode-form.apistipulate
package ncf = nextcode_form; # nextcode_form is from src/lib/compiler/back/top/nextcode/nextcode-form.pkgherein
api Run_Optional_Nextcode_Improvers {
run_optional_nextcode_improvers
:
( ncf::Function, # Function to be improved ("optimized").
Null_Or( unsafe::unsafe_chunk::Chunk ),
Bool
)
->
ncf::Function; # Improved version of input function.
};
end;
# This generic is expanded in:
#
# src/lib/compiler/back/top/main/backend-tophalf-g.pkg # Machine_Properties is from src/lib/compiler/back/low/main/main/machine-properties.apistipulate
package acf = anormcode_form; # anormcode_form is from src/lib/compiler/back/top/anormcode/anormcode-form.pkg package coc = global_controls::compiler; # global_controls is from src/lib/compiler/toplevel/main/global-controls.pkg package hcf = highcode_form; # highcode_form is from src/lib/compiler/back/top/highcode/highcode-form.pkg package hct = highcode_type; # highcode_type is from src/lib/compiler/back/top/highcode/highcode-type.pkg package hut = highcode_uniq_types; # highcode_uniq_types is from src/lib/compiler/back/top/highcode/highcode-uniq-types.pkg package ibc = inline_nextcode_buckpass_calls; # inline_nextcode_buckpass_calls is from src/lib/compiler/back/top/improve-nextcode/inline-nextcode-buckpass-calls.pkg package iht = int_hashtable; # int_hashtable is from src/lib/src/int-hashtable.pkg package rup = replace_unlimited_precision_int_ops_in_nextcode; # replace_unlimited_precision_int_ops_in_nextcode is from src/lib/compiler/back/top/improve-nextcode/replace-unlimited-precision-int-ops-in-nextcode.pkg package tmp = highcode_codetemp; # highcode_codetemp is from src/lib/compiler/back/top/highcode/highcode-codetemp.pkgherein
generic package run_optional_nextcode_improvers_g (
# =================================
#
machine_properties: Machine_Properties # Typically src/lib/compiler/back/low/main/intel32/machine-properties-intel32.pkg #
)
: (weak) Run_Optional_Nextcode_Improvers # Run_Optional_Nextcode_Improvers is from src/lib/compiler/back/top/improve-nextcode/run-optional-nextcode-improvers-g.pkg {
package clf = clean_nextcode_g( machine_properties ); # clean_nextcode_g is from src/lib/compiler/back/top/improve-nextcode/clean-nextcode-g.pkg package dfi = do_nextcode_inlining_g( machine_properties ); # do_nextcode_inlining_g is from src/lib/compiler/back/top/improve-nextcode/do-nextcode-inlining-g.pkg package fla = convert_monoarg_to_multiarg_nextcode_g( machine_properties ); # convert_monoarg_to_multiarg_nextcode_g is from src/lib/compiler/back/top/improve-nextcode/convert-monoarg-to-multiarg-nextcode-g.pkg package unc = uncurry_nextcode_functions_g( machine_properties ); # uncurry_nextcode_functions_g is from src/lib/compiler/back/top/improve-nextcode/uncurry-nextcode-functions-g.pkg # split_nextcode_fns_into_known_vs_escaping_versions_g is from src/lib/compiler/back/top/improve-nextcode/split-nextcode-fns-into-known-vs-escaping-versions-g.pkg package spl = split_nextcode_fns_into_known_vs_escaping_versions_g( machine_properties );
say = global_controls::print::say;
# Obsolete table: used by optional_nextcode_improvers as a dummy template
#
exception ZZZ;
my dummy_table: iht::Hashtable( hut::Uniqtypoid )
=
iht::make_hashtable { size_hint => 32, not_found_exception => ZZZ };
#
fun run_optional_nextcode_improvers (function, _, after_closure)
=
{
# NOTE: The third argument to reduce is currently ignored.
# It used to be used for reopening closures.
table = dummy_table;
debug = *coc::debugnextcode; # FALSE
fun debugprint s = if debug say s; fi;
fun debugflush () = if debug global_controls::print::flush(); fi;
clicked = REF 0;
fun click (string: String)
=
{ debugprint string;
#
clicked := *clicked+1;
};
nextcode_size = REF 0;
pr_c
=
pr_fn (global_controls::compiler::printit, prettyprint_nextcode::print_nextcode_function)
where
fun pr_fn (flag, print_e) s e
=
if *flag
say ("\n\n[After " + s + " ...]\n\n");
print_e e;
e;
else
e;
fi;
end;
fun contract last f
=
{ f' = { clicked := 0;
#
clf::clean_nextcode { function=>f, table, click, last, size=>nextcode_size };
};
apply debugprint ["Contract stats: nextcode_size = ", int::to_string *nextcode_size,
", clicks = ", int::to_string *clicked, "\n"];
f';
};
# Dropargs are turned off in first_contract
# to ban unsafe eta reduction:
#
fun first_contract f
=
{ dpargs = *coc::dropargs;
f' = { clicked := 0;
#
coc::dropargs := FALSE;
#
clf::clean_nextcode { function=>f, table, click, last=>FALSE, size=>nextcode_size };
};
apply debugprint ["Contract stats: nextcode_size = ", int::to_string *nextcode_size,
", clicks = ", int::to_string *clicked, "\n"];
coc::dropargs := dpargs;
f';
};
# Certain contractions are prohibited
# in the last contract phase:
#
fun last_contract f
=
{ f' = { clicked := 0;
#
clf::clean_nextcode { function=>f, table, click, last=>TRUE, size=>nextcode_size };
};
apply debugprint ["Contract stats: nextcode_size = ", int::to_string *nextcode_size,
", clicks = ", int::to_string *clicked, "\n"];
f';
};
fun expand (function, bodysize, unroll)
=
{ clicked := 0;
if (not *coc::beta_expand)
#
function;
else
function' = dfi::do_nextcode_inlining { function, click, bodysize, after_closure, table, unroll, do_headers=>TRUE };
apply debugprint ["Expand stats: clicks = ", int::to_string *clicked, "\n"];
function';
fi;
};
fun zeroexpand function
=
dfi::do_nextcode_inlining { function, click, bodysize=>0, after_closure, table, unroll=>FALSE, do_headers=>FALSE };
fun flatten function
=
{ clicked := 0;
if (not *coc::flattenargs)
#
function;
else
function' = fla::convert_monoarg_to_multiarg_nextcode { function, table, click };
apply debugprint ["Argument-flattening statistics: clicks = ", int::to_string *clicked, "\n"];
function';
fi;
};
fun unroll_contract (f, n)
=
{ f' = expand (f, n, TRUE);
c = *clicked;
if (c > 0) (c, contract TRUE f');
else (c, f');
fi;
};
fun expand_flatten_contract (f, n)
=
{ f1 = expand (f, n, FALSE);
c1 = *clicked;
f2 = flatten f1;
c2 = *clicked;
c = c1+c2;
if (c > 0 ) (c, contract FALSE f2);
else (c, f2); fi;
};
fun inline_buckpass_calls f
=
{ clicked := 0;
if *coc::eta
#
f' = ibc::inline_nextcode_buckpass_calls { function=>f, click };
apply debugprint ["Buckpass-inlining stats: clicks = ", int::to_string *clicked, "\n" ];
f';
else
f;
fi;
};
fun uncurry f
=
if after_closure
f;
else
clicked := 0;
if (not *coc::uncurry)
f;
else
f' = unc::uncurry_nextcode_functions { function=>f, table, click };
apply debugprint [ "Uncurry stats: clicks = ", int::to_string *clicked, "\n" ];
f';
fi;
fi;
fun split_known_escaping_functions function
=
{ clicked := 0;
if (not *coc::split_known_escaping_functions)
#
function;
else
function' = spl::split_nextcode_fns_into_known_vs_escaping_versions { function, table, click };
apply debugprint ["Etasplit stats: clicks = ", int::to_string *clicked, "\n"];
function';
fi;
};
fun lambdaprop x = x;
/* if *coc::lambdaprop then (debugprint "\nLambdaprop:"; CfUse::hoist x)
else x */
bodysize = *coc::bodysize;
rounds = *coc::rounds;
reducemore = *coc::reducemore;
# Note the parameter k starts at rounds..0
#
fun linear_decrease k
=
(bodysize * k) / rounds;
/*** NOT USED ***
fun double_linear k = (bodysize*2*k div rounds) - bodysize
fun cosine_decrease k =
float::trunc (real bodysize * (math::cos (1.5708*(1.0 - real k / real rounds))))
***/
# This function is just hacked up.
# Someday it should be tuned. XXX BUGGO FIXME
#
fun cycle (0, TRUE, fn) => fn;
cycle (0, FALSE, fn) => unroll fn;
cycle (k, unrolled, fn)
=>
{ fn = lambdaprop fn;
my (c, fn)
=
if (*coc::beta_expand
or *coc::flattenargs
)
expand_flatten_contract (fn, linear_decrease k);
else
(0, fn);
fi;
# prC "cycle_contract" fn
if (c * 1000 <= *nextcode_size * reducemore)
#
if unrolled fn;
else unroll fn;
fi;
else
cycle (k - 1, unrolled, fn);
fi;
};
end
also
fun unroll fn
=
{ my (c, fn') = unroll_contract (fn, bodysize);
c > 0 ?? cycle (rounds, TRUE, fn')
:: fn';
};
if (rounds < 0)
#
function;
else
fun do ("first_contract", f) => first_contract f;
do ("eta", f) => inline_buckpass_calls f;
do ("uncurry", f) => uncurry f;
do ("split_known_escaping_functions", f) => split_known_escaping_functions f;
do ("last_contract", f) => last_contract f;
do ("cycle_expand", f) => cycle (rounds, not *coc::unroll, f);
do ("contract", f) => contract FALSE f;
do ("flatten", f) => flatten f;
do ("zeroexpand", f) => zeroexpand f;
do ("expand", f) => expand (f, bodysize, FALSE);
do ("print", f) => { prettyprint_nextcode::print_nextcode_function f; f; };
do (p, f) => { say("\nUnknown nextcode phase '" + p + "'\n"); f; };
end;
optimized
=
fold_forward do function *coc::optional_nextcode_improvers;
# function1 = first_contract function
# function2 = inline_buckpass_calls function1
# function3 = uncurry function2
# function4 = split_known_escaping_functions function3
# function5 = cycle (rounds, not *coc::unroll, function4)
# function6 = inline_buckpass_calls function5 /* ZSH added this new phase */
# function7 = last_contract function6
# my optimized function7
rup::replace_unlimited_precision_int_ops_in_nextcode
{
function => optimized,
mk_kvar => tmp::issue_highcode_codetemp,
mk_i32var => \\ ()
=
{ v = tmp::issue_highcode_codetemp ();
iht::set
table
(v, hcf::int1_uniqtypoid);
v;
}
};
fi
then
{ debugprint "\n";
debugflush();
};
}; # fun run_optional_nextcode_improvers
}; # generic package run_optional_nextcode_improvers_g
end;
## Copyright 1989 by Bell Laboratories
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.