const set of category: basicExpressionCategories is {
TYPEOBJECT, INTOBJECT, BIGINTOBJECT, CHAROBJECT, STRIOBJECT,
BSTRIOBJECT, ARRAYOBJECT, HASHOBJECT, STRUCTOBJECT, SETOBJECT,
FILEOBJECT, SOCKETOBJECT, LISTOBJECT, FLOATOBJECT, BOOLOBJECT,
WINOBJECT, POINTLISTOBJECT, PROCESSOBJECT, ENUMLITERALOBJECT,
REFLISTOBJECT, SYMBOLOBJECT};
const set of string: specialActions is
{"ARR_SORT", "ARR_SORT_REVERSE",
"BIG_PARSE1", "BIN_AND", "BIN_OR", "BIN_XOR", "BLN_ICONV1",
"BLN_ICONV3", "BLN_ORD", "BLN_TERNARY", "BST_PARSE1", "CHR_ICONV1",
"CHR_ICONV3", "CHR_ORD", "ENU_ICONV2", "ENU_LIT", "ENU_ORD2",
"FLT_PARSE1", "HSH_CONTAINS", "HSH_EXCL", "HSH_INCL", "HSH_KEYS",
"INT_ICONV1", "INT_ICONV3", "INT_ODD", "INT_PARSE1", "SET_BASELIT",
"SET_CONV1", "SET_CONV3", "SET_ELEM", "SET_EXCL", "SET_INCL",
"SET_NOT_ELEM", "SET_RAND"};
const func boolean: isPureFunction (in reference: function) is forward;
const func boolean: isConstant (in reference: current_expression,
in boolean_obj_hash: local_objects) is forward;
const func boolean: isConstantCall (in reference: current_expression,
in boolean_obj_hash: local_objects) is func
result
var boolean: isConstantCall is FALSE;
local
const set of string: copyActions is
{"ACT_CPY", "ARR_CPY", "BIG_CPY", "BLN_CPY", "BST_CPY", "CHR_CPY",
"DRW_CPY", "ENU_CPY", "FIL_CPY", "FLT_CPY", "HSH_CPY", "INT_CPY",
"ITF_CPY", "LST_CPY", "PCS_CPY", "PLT_CPY", "POL_CPY", "PRC_CPY",
"PRG_CPY", "REF_CPY", "RFL_CPY", "SCT_CPY", "SET_CPY", "SOC_CPY",
"SQL_CPY_DB", "SQL_CPY_STMT", "STR_CPY", "TYP_CPY"};
var ref_list: formal_params is ref_list.EMPTY;
var ref_list: actual_params is ref_list.EMPTY;
var reference: function is NIL;
var integer: number is 0;
var reference: formal_param is NIL;
var reference: actual_param is NIL;
var category: paramCategory is category.value;
var string: action_name is "";
begin
actual_params := getValue(current_expression, ref_list);
function := actual_params[1];
actual_params := actual_params[2 ..];
if not isVar(function) then
if category(function) in basicExpressionCategories then
isConstantCall := TRUE;
elsif isPureFunction(function) then
isConstantCall := TRUE;
formal_params := formalParams(function);
for number range 1 to length(actual_params) do
formal_param := formal_params[number];
actual_param := actual_params[number];
paramCategory := category(formal_param);
if paramCategory <> SYMBOLOBJECT and paramCategory <> TYPEOBJECT then
if not isConstant(actual_param, local_objects) then
isConstantCall := FALSE;
end if;
end if;
end for;
else
if category(function) = ACTOBJECT then
action_name := str(getValue(function, ACTION));
if action_name = "PRC_NOOP" then
isConstantCall := TRUE;
for actual_param range actual_params until not isConstantCall do
if not isConstant(actual_param, local_objects) then
isConstantCall := FALSE;
end if;
end for;
elsif action_name in copyActions then
noop;
end if;
end if;
end if;
end if;
end func;
const func boolean: isConstant (in reference: current_expression,
in boolean_obj_hash: local_objects) is func
result
var boolean: isConstant is FALSE;
local
var category: exprCategory is category.value;
begin
if current_expression in local_objects then
isConstant := TRUE;
elsif not isVar(current_expression) then
exprCategory := category(current_expression);
if exprCategory = MATCHOBJECT or exprCategory = CALLOBJECT then
isConstant := isConstantCall(current_expression, local_objects);
elsif exprCategory in basicExpressionCategories then
isConstant := TRUE;
end if;
end if;
end func;
const func boolean: isPureBlockFunction (in reference: function) is func
result
var boolean: isPureBlockFunction is FALSE;
local
var type: function_type is void;
var reference: result_object is NIL;
var ref_list: local_object_list is ref_list.EMPTY;
var reference: obj is NIL;
var boolean_obj_hash: local_objects is boolean_obj_hash.value;
begin
function_type := getType(function);
result_object := resultVar(function);
if not isVarfunc(function_type) then
if result_object <> NIL then
local_object_list := make_list(result_object);
end if;
local_object_list &:= formalParams(function) & localVars(function);
for obj range local_object_list do
local_objects @:= [obj] TRUE;
end for;
isPureBlockFunction := isConstant(body(function), local_objects);
end if;
end func;
const func boolean: isPureFunction (in reference: function) is func
result
var boolean: isPureFunction is FALSE;
local
const set of string: pureFunctionActions is
{"ACT_EQ", "ACT_NE", "ACT_ORD", "ACT_STR",
"ARR_ARRLIT", "ARR_ARRLIT2", "ARR_BASELIT", "ARR_BASELIT2", "ARR_CAT",
"ARR_CONV", "ARR_EMPTY", "ARR_EXTEND", "ARR_GEN", "ARR_HEAD", "ARR_IDX",
"ARR_LNG", "ARR_MAXIDX", "ARR_MINIDX", "ARR_RANGE", "ARR_SORT",
"ARR_SUBARR", "ARR_TAIL", "ARR_TIMES",
"BIG_ABS", "BIG_ADD", "BIG_BIT_LENGTH", "BIG_CMP", "BIG_CONV", "BIG_DIV",
"BIG_EQ", "BIG_FROM_BSTRI_BE", "BIG_FROM_BSTRI_LE", "BIG_GCD", "BIG_GE",
"BIG_GT", "BIG_HASHCODE", "BIG_ICONV1", "BIG_ICONV3", "BIG_IPOW",
"BIG_LE", "BIG_LOG10", "BIG_LOG2", "BIG_LOWEST_SET_BIT", "BIG_LSHIFT",
"BIG_LT", "BIG_MDIV", "BIG_MOD", "BIG_MULT", "BIG_NE", "BIG_NEGATE",
"BIG_ODD", "BIG_ORD", "BIG_PARSE1", "BIG_PARSE_BASED", "BIG_PLUS",
"BIG_PRED", "BIG_radix", "BIG_RADIX", "BIG_REM", "BIG_RSHIFT",
"BIG_SBTR", "BIG_STR", "BIG_SUCC", "BIG_TO_BSTRI_BE", "BIG_TO_BSTRI_LE",
"BIG_VALUE",
"BIN_AND", "BIN_BIG", "BIN_BINARY", "BIN_CARD", "BIN_CMP", "BIN_LSHIFT",
"BIN_N_BYTES_BE", "BIN_N_BYTES_LE", "BIN_OR", "BIN_ORD", "BIN_radix",
"BIN_RADIX", "BIN_RSHIFT", "BIN_STR", "BIN_XOR",
"BLN_AND", "BLN_EQ", "BLN_GE", "BLN_GT", "BLN_ICONV1", "BLN_ICONV3",
"BLN_LE", "BLN_LT", "BLN_NE", "BLN_NOT", "BLN_OR", "BLN_ORD", "BLN_PRED",
"BLN_SUCC", "BLN_TERNARY", "BLN_VALUE",
"BST_CAT", "BST_CMP", "BST_EMPTY", "BST_EQ", "BST_HASHCODE", "BST_IDX",
"BST_LNG", "BST_NE", "BST_PARSE1", "BST_STR", "BST_VALUE",
"CHR_CLIT", "CHR_CMP", "CHR_EQ", "CHR_GE", "CHR_GT", "CHR_HASHCODE",
"CHR_ICONV1", "CHR_ICONV3", "CHR_LE", "CHR_LOW", "CHR_LT", "CHR_NE",
"CHR_ORD", "CHR_PRED", "CHR_STR", "CHR_SUCC", "CHR_UP", "CHR_VALUE",
"CMD_CONFIG_VALUE", "DRW_VALUE",
"ENU_CONV", "ENU_EQ", "ENU_ICONV2", "ENU_NE", "ENU_ORD2", "ENU_VALUE",
"FIL_EQ", "FIL_NE", "FIL_VALUE",
"FLT_ABS", "FLT_ACOS", "FLT_ADD", "FLT_ASIN", "FLT_ATAN", "FLT_ATAN2",
"FLT_BITS2DOUBLE", "FLT_BITS2SINGLE", "FLT_CEIL", "FLT_CMP", "FLT_COS",
"FLT_COSH", "FLT_DGTS", "FLT_DIV", "FLT_DOUBLE2BITS", "FLT_EQ",
"FLT_EXP", "FLT_FLOOR", "FLT_GE", "FLT_GT", "FLT_HASHCODE", "FLT_ICONV1",
"FLT_ICONV3", "FLT_IPOW", "FLT_ISNAN", "FLT_ISNEGATIVEZERO", "FLT_LE",
"FLT_LOG", "FLT_LOG10", "FLT_LOG2", "FLT_LSHIFT", "FLT_LT", "FLT_MOD",
"FLT_MULT", "FLT_NE", "FLT_NEGATE", "FLT_PARSE1", "FLT_PLUS", "FLT_POW",
"FLT_REM", "FLT_ROUND", "FLT_RSHIFT", "FLT_SBTR", "FLT_SCI", "FLT_SIN",
"FLT_SINGLE2BITS", "FLT_SINH", "FLT_SQRT", "FLT_STR", "FLT_TAN",
"FLT_TANH", "FLT_TRUNC", "FLT_VALUE",
"HSH_CONTAINS", "HSH_EMPTY", "HSH_IDX", "HSH_KEYS", "HSH_LNG",
"HSH_VALUES",
"INT_ABS", "INT_ADD", "INT_BINOM", "INT_BIT_LENGTH", "INT_BYTES_BE",
"INT_BYTES_BE_2_INT", "INT_BYTES_BE_2_UINT", "INT_BYTES_BE_SIGNED",
"INT_BYTES_BE_UNSIGNED", "INT_BYTES_LE_2_INT", "INT_BYTES_LE_2_UINT",
"INT_BYTES_LE_SIGNED", "INT_BYTES_LE_UNSIGNED", "INT_CMP", "INT_DIV",
"INT_EQ", "INT_FACT", "INT_GE", "INT_GT", "INT_HASHCODE", "INT_ICONV1",
"INT_ICONV3", "INT_LE", "INT_LOG10", "INT_LOG2", "INT_LOWEST_SET_BIT",
"INT_LPAD0", "INT_LSHIFT", "INT_LT", "INT_MDIV", "INT_MOD", "INT_MULT",
"INT_NE", "INT_NEGATE", "INT_N_BYTES_BE_SIGNED",
"INT_N_BYTES_BE_UNSIGNED", "INT_N_BYTES_LE_SIGNED",
"INT_N_BYTES_LE_UNSIGNED", "INT_ODD", "INT_PARSE1", "INT_PLUS",
"INT_POW", "INT_PRED", "INT_radix", "INT_RADIX", "INT_REM",
"INT_RSHIFT", "INT_SBTR", "INT_SQRT", "INT_STR", "INT_SUCC",
"INT_VALUE",
"ITF_CMP", "ITF_EQ", "ITF_HASHCODE", "ITF_NE",
"LST_CAT", "LST_EMPTY", "LST_HEAD", "LST_IDX", "LST_LNG", "LST_RANGE",
"LST_TAIL",
"PLT_BSTRING", "PLT_CMP", "PLT_EQ", "PLT_HASHCODE", "PLT_NE",
"PLT_POINT_LIST", "PLT_VALUE",
"PRG_EQ", "PRG_NE",
"REF_CMP", "REF_EQ", "REF_NE", "REF_NIL",
"RFL_CAT", "RFL_ELEM", "RFL_EMPTY", "RFL_EQ", "RFL_HEAD", "RFL_IDX",
"RFL_IPOS", "RFL_LNG", "RFL_NE", "RFL_NOT_ELEM", "RFL_POS", "RFL_RANGE",
"RFL_TAIL", "RFL_VALUE",
"SCT_LNG", "SCT_SELECT",
"SET_ARRLIT", "SET_BASELIT", "SET_CARD", "SET_CMP", "SET_CONV1",
"SET_CONV3", "SET_DIFF", "SET_ELEM", "SET_EMPTY", "SET_EQ", "SET_GE",
"SET_GT", "SET_HASHCODE", "SET_ICONV1", "SET_ICONV3", "SET_INTERSECT",
"SET_LE", "SET_LT", "SET_MAX", "SET_MIN", "SET_NE", "SET_NEXT",
"SET_NOT_ELEM", "SET_SCONV1", "SET_SCONV3", "SET_SYMDIFF", "SET_UNION",
"SET_VALUE",
"SOC_EQ", "SOC_NE",
"STR_CAT", "STR_CHIPOS", "STR_CHPOS", "STR_CHSPLIT", "STR_CLIT",
"STR_CMP", "STR_EQ", "STR_FROM_UTF8", "STR_GE", "STR_GT", "STR_HASHCODE",
"STR_HEAD", "STR_IDX","STR_IPOS", "STR_LE", "STR_LIT", "STR_LNG",
"STR_LOW", "STR_LPAD", "STR_LPAD0", "STR_LT", "STR_LTRIM", "STR_MULT",
"STR_NE", "STR_POS", "STR_RANGE", "STR_RCHIPOS", "STR_RCHPOS",
"STR_REPL", "STR_RIPOS", "STR_RPAD", "STR_RPOS", "STR_RTRIM",
"STR_SPLIT", "STR_STR", "STR_SUBSTR", "STR_SUBSTR_FIXLEN", "STR_TAIL",
"STR_TO_UTF8", "STR_TRIM", "STR_UP", "STR_VALUE",
"TYP_CMP", "TYP_EQ", "TYP_NE"};
const set of string: specialFunctionActions is
{"PRC_FOR_DOWNTO", "PRC_FOR_TO", "SET_INCL", "TYP_VARCONV"};
var category: functionCategory is category.value;
var string: action_name is "";
begin
functionCategory := category(function);
if functionCategory = ACTOBJECT then
action_name := str(getValue(function, ACTION));
isPureFunction := action_name in pureFunctionActions or action_name in specialFunctionActions;
elsif functionCategory = BLOCKOBJECT then
isPureFunction := isPureBlockFunction(function);
end if;
end func;
const func boolean: isConstant (in reference: current_expression) is forward;
const func boolean: isConstantCall (in reference: current_expression) is func
result
var boolean: isConstantCall is FALSE;
local
var ref_list: params is ref_list.EMPTY;
var reference: function is NIL;
var reference: obj is NIL;
begin
params := getValue(current_expression, ref_list);
function := params[1];
params := params[2 ..];
if not isVar(function) then
if category(function) in basicExpressionCategories or
isPureFunction(function) then
isConstantCall := TRUE;
for obj range params until not isConstantCall do
if not isConstant(obj) then
isConstantCall := FALSE;
end if;
end for;
end if;
end if;
end func;
const func boolean: isConstant (in reference: current_expression) is func
result
var boolean: isConstant is FALSE;
local
var category: exprCategory is category.value;
begin
if not isVar(current_expression) then
exprCategory := category(current_expression);
if exprCategory = MATCHOBJECT or exprCategory = CALLOBJECT then
isConstant := isConstantCall(current_expression);
elsif exprCategory in basicExpressionCategories then
isConstant := TRUE;
elsif exprCategory = BLOCKOBJECT then
isConstant := TRUE;
elsif exprCategory = ACTOBJECT then
isConstant := TRUE;
end if;
end if;
end func;
const func boolean: isConstantExpr (in reference: current_expression) is func
result
var boolean: isConstantExpr is FALSE;
local
var category: exprCategory is category.value;
begin
if not isVar(current_expression) then
exprCategory := category(current_expression);
if exprCategory = MATCHOBJECT or exprCategory = CALLOBJECT then
isConstantExpr := isConstantCall(current_expression);
end if;
end if;
end func;
const func reference: evaluate (in reference: current_expression,
in ref_list: arguments) is func
result
var reference: evaluatedExpr is NIL;
local
var reference: currExpr is NIL;
begin
currExpr := alloc(current_expression);
setValue(currExpr, arguments);
block
evaluatedExpr := evaluate(prog, currExpr);
exception
catch NUMERIC_ERROR: noop;
catch OVERFLOW_ERROR: noop;
catch RANGE_ERROR: noop;
catch INDEX_ERROR: noop;
catch FILE_ERROR: noop;
catch DATABASE_ERROR: noop;
end block;
end func;
const func boolean: canEvaluateSpecialAction (in reference: current_expression,
inout reference: evaluatedExpr) is func
result
var boolean: okay is FALSE;
local
var category: exprCategory is category.value;
var ref_list: formal_params is ref_list.EMPTY;
var ref_list: actual_params is ref_list.EMPTY;
var ref_list: new_actual_params is ref_list.EMPTY;
var reference: function is NIL;
var integer: number is 0;
var reference: formal_param is NIL;
var reference: actual_param is NIL;
var category: paramCategory is category.value;
var boolean: inlineParamFound is FALSE;
begin
if not isVar(current_expression) then
exprCategory := category(current_expression);
if exprCategory = MATCHOBJECT or exprCategory = CALLOBJECT then
actual_params := getValue(current_expression, ref_list);
function := actual_params[1];
actual_params := actual_params[2 ..];
if category(function) = ACTOBJECT and
str(getValue(function, ACTION)) in specialActions then
formal_params := formalParams(function);
new_actual_params &:= make_list(function);
for number range 1 to length(actual_params) do
formal_param := formal_params[number];
actual_param := actual_params[number];
paramCategory := category(formal_param);
if paramCategory <> SYMBOLOBJECT and paramCategory <> TYPEOBJECT and
not isConstant(actual_param) and actual_param in inlineParam and
inlineParam[actual_param][1].paramValue <> NIL then
inlineParamFound := TRUE;
new_actual_params &:= make_list(inlineParam[actual_param][1].paramValue);
else
new_actual_params &:= make_list(actual_param);
end if;
end for;
if inlineParamFound then
evaluatedExpr := evaluate(current_expression, new_actual_params);
if evaluatedExpr <> NIL then
if category(evaluatedExpr) in basicExpressionCategories then
incr(countEvaluations);
okay := TRUE;
end if;
end if;
end if;
end if;
end if;
end if;
end func;
const func boolean: isFuncParamData (in reference: currExpr) is forward;
const func boolean: getConstant (in var reference: currExpr, in category: exprCategory,
inout reference: evaluatedExpr) is func
result
var boolean: okay is FALSE;
begin
if evaluate_const_expr >= 1 and not isFuncParamData(currExpr) then
if canEvaluateSpecialAction(currExpr, evaluatedExpr) then
okay := TRUE;
elsif currExpr in inlineParam and
inlineParam[currExpr][1].paramValue <> NIL then
evaluatedExpr := inlineParam[currExpr][1].paramValue;
okay := TRUE;
elsif category(currExpr) = exprCategory and
not isVar(currExpr) then
evaluatedExpr := currExpr;
incr(countEvaluations);
okay := TRUE;
elsif evaluate_const_expr >= 2 and isConstant(currExpr) then
block
evaluatedExpr := evaluate(prog, currExpr);
if evaluatedExpr <> NIL then
if category(evaluatedExpr) = exprCategory then
incr(countEvaluations);
okay := TRUE;
end if;
end if;
exception
catch NUMERIC_ERROR: noop;
catch OVERFLOW_ERROR: noop;
catch RANGE_ERROR: noop;
catch INDEX_ERROR: noop;
catch FILE_ERROR: noop;
catch DATABASE_ERROR: noop;
end block;
end if;
end if;
end func;
const func boolean: getConstant (in var reference: currExpr,
inout reference: evaluatedExpr) is func
result
var boolean: okay is FALSE;
begin
if evaluate_const_expr >= 1 and not isFuncParamData(currExpr) then
if canEvaluateSpecialAction(currExpr, evaluatedExpr) then
okay := TRUE;
elsif currExpr in inlineParam and
inlineParam[currExpr][1].paramValue <> NIL then
evaluatedExpr := inlineParam[currExpr][1].paramValue;
okay := TRUE;
elsif category(currExpr) in basicExpressionCategories and
not isVar(currExpr) then
evaluatedExpr := currExpr;
incr(countEvaluations);
okay := TRUE;
elsif evaluate_const_expr >= 2 and isConstant(currExpr) then
block
evaluatedExpr := evaluate(prog, currExpr);
if evaluatedExpr <> NIL then
if category(evaluatedExpr) in basicExpressionCategories then
incr(countEvaluations);
okay := TRUE;
end if;
end if;
exception
catch NUMERIC_ERROR: noop;
catch OVERFLOW_ERROR: noop;
catch RANGE_ERROR: noop;
catch INDEX_ERROR: noop;
catch FILE_ERROR: noop;
catch DATABASE_ERROR: noop;
end block;
end if;
end if;
end func;
const func boolean: isFunctionCallingSpecialAction (in reference: function) is func
result
var boolean: isFunctionCallingSpecialAction is FALSE;
local
var reference: calledFunction is NIL;
begin
if category(body(function)) = CALLOBJECT then
calledFunction := getValue(body(function), ref_list)[1];
if category(calledFunction) = ACTOBJECT and
str(getValue(calledFunction, ACTION)) in specialActions then
isFunctionCallingSpecialAction := TRUE;
end if;
end if;
end func;
const func boolean: isPureExpression (in reference: currExpr) is func
result
var boolean: isPureExpression is FALSE;
local
const set of category: localsAndParameters is
{LOCALVOBJECT, VALUEPARAMOBJECT, REFPARAMOBJECT};
var category: exprCategory is category.value;
var ref_list: params is ref_list.EMPTY;
var reference: function is NIL;
var reference: obj is NIL;
begin
exprCategory := category(currExpr);
if exprCategory in basicExpressionCategories then
isPureExpression := TRUE;
elsif exprCategory in localsAndParameters then
isPureExpression := TRUE;
elsif exprCategory = MATCHOBJECT or exprCategory = CALLOBJECT then
params := getValue(currExpr, ref_list);
function := params[1];
params := params[2 ..];
isPureExpression :=
category(function) in basicExpressionCategories or
isPureFunction(function);
for obj range params until not isPureExpression do
if not isPureExpression(obj) then
isPureExpression := FALSE;
end if;
end for;
end if;
end func;
const func boolean: equalExpressions (in reference: expression1,
in reference: expression2) is func
result
var boolean: isEqual is FALSE;
local
var category: exprCategory1 is category.value;
var category: exprCategory2 is category.value;
var ref_list: params1 is ref_list.EMPTY;
var ref_list: params2 is ref_list.EMPTY;
var reference: function1 is NIL;
var reference: function2 is NIL;
var integer: index is 0;
var reference: obj1 is NIL;
var reference: obj2 is NIL;
begin
if expression1 = expression2 then
isEqual := TRUE;
else
exprCategory1 := category(expression1);
exprCategory2 := category(expression2);
if exprCategory1 = exprCategory2 then
if exprCategory1 = INTOBJECT then
isEqual := getValue(expression1, integer) = getValue(expression2, integer);
elsif exprCategory1 = MATCHOBJECT or exprCategory1 = CALLOBJECT then
params1 := getValue(expression1, ref_list);
function1 := params1[1];
params1 := params1[2 ..];
params2 := getValue(expression2, ref_list);
function2 := params2[1];
params2 := params2[2 ..];
if function1 = function2 and length(params1) = length(params2) then
isEqual := TRUE;
for index range 1 to length(params1) until not isEqual do
if not equalExpressions(params1[index], params2[index]) then
isEqual := FALSE;
end if;
end for;
end if;
end if;
end if;
end if;
end func;