% BEGIN LICENSE BLOCK
% Version: CMPL 1.1
%
% The contents of this file are subject to the Cisco-style Mozilla Public
% License Version 1.1 (the "License"); you may not use this file except
% in compliance with the License.  You may obtain a copy of the License
% at www.eclipse-clp.org/license.
% 
% Software distributed under the License is distributed on an "AS IS"
% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
% the License for the specific language governing rights and limitations
% under the License. 
% 
% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
% Portions created by the Initial Developer are
% Copyright (C) 2006 Cisco Systems, Inc.  All Rights Reserved.
% 
% Contributor(s): Joachim Schimpf.
% 
% END LICENSE BLOCK
% ----------------------------------------------------------------------
% System:	ECLiPSe Constraint Logic Programming System
% Component:	ECLiPSe III compiler
% Version:	$Id: compiler_indexing.ecl,v 1.14 2017/02/01 02:05:15 jschimpf Exp $
%----------------------------------------------------------------------

:- module(compiler_indexing).

:- comment(summary, "ECLiPSe III compiler - indexing").
:- comment(copyright, "Cisco Technology Inc").
:- comment(author, "Joachim Schimpf").
:- comment(date, "$Date: 2017/02/01 02:05:15 $").

:- use_module(compiler_common).
:- import state_lookup_binding/3 from compiler_analysis.

:- lib(hash).

:- comment(desc, ascii("
   This pass finds information that can be exploited for indexing (i.e.
   filtering alternatives from disjunctions). The disjunctions are annotated
   with this information.

   The code generator uses this information to generate switch-instructions
   and try-sequences.
")).


% Structure describing a guard test:
% Specifies which values of a variable the guard will accept.
% Guard goals that cannot be indexed are represented with varid:0,class:[]
:- local struct(guard(
    	branchnr,	% branch in which this guard occurs
	varid,		% variable that this guard tests (or 0)
	class		% list of: atomic Tag name, value(Val,Tag) or N/A
    )).


:- export indexing_transformation/3.

indexing_transformation(Goals, OutGoals, Options) :-
	indexing_transformation(Goals, OutGoals, det, Options).

indexing_transformation([], [], _Det, _Options).
indexing_transformation([Goal|Goals], OutGoals, Det, Options) :-
	( Goal = disjunction{branches:Branches,determinism:BranchDets} ->
	    OutGoals = [OutGoal|OutGoals1],
	    update_struct(disjunction, [branches:OutBranches], Goal, OutGoal),
	    index_disjunction(Goal),
	    dump_indexes(Goal, Options),
	    (
		foreach(Branch,Branches),
		foreach(OutBranch,OutBranches),
		foreacharg(BranchDet,BranchDets),
		param(Options)
	    do
		indexing_transformation(Branch, OutBranch, BranchDet, Options)
	    )

	; Goal = goal{functor:cut_to/1,kind:simple,definition_module:sepia_kernel,
			args:[variable{varid:VarId}],state:State,callpos:CutPos} ->
	    % Eliminate cuts that are always in the last (or only) alternative
	    (
		state_lookup_binding(State, VarId, ++(cutpoint(SaveCutPos))),
		in_following_branch_guard(SaveCutPos, CutPos),
		last_alternative(Det)
	    ->
		OutGoals = OutGoals1		% eliminate the cut!
	    ;
		OutGoals = [Goal|OutGoals1]
	    )
	;
	    OutGoals = [Goal|OutGoals1]
	),
	indexing_transformation(Goals, OutGoals1, Det, Options).


/*
Algorithm:
    Scan the guards in every branch of the disjunction.  The guards
    are the leading goals in the disjunctions up to, but not
    including, the first regular goal or the first cut(_to).

    A guard that can be used for indexing is represented as a struct
    guard{}, which describes the conditions under which a guard is
    satisfied for a particular variable.  It lists the value classes
    for which the guard must (t) or may (m) pass.  For example, a
    guard X=3 in branch 5 of the disjunctions is represented as
    guard{branchnr:5,varid:Xid,[[integer,3]-t]) A value class is a
    list containing the tag and optionally a value.

    Then the guards are grouped by variable, and translated into
    a decision tree, where the first level corresponds to the tags,
    and the second level to values.  However, the tree implementation
    is general and the structure can be made more complex.

    Finally, the decision trees for the different variables are
    evaluated, and ordered according to their selectivity.

    The weighted decision trees form the input for the code generator.

    CAUTION: the entries in the index tree *assume* (for purposes of
    definitive passing of guard and commit) that the indexing code
    tests for exactly the tag/value given in the tree entry.
*/

index_disjunction(disjunction{branches:Branches,branchlabels:BranchLabelArray,
		state:StartState,
		indexvars:Args,indexes:OrderedIndexes,determinism:Determinism}) :-

	% Collect all guards of all branches into one list of guard{}
	hash_create(VaridsInCommittedGuards),
	(
	    % for each branch in the disjunction
	    count(I,1,NBranches),
	    foreach(Branch,Branches),
	    fromto(GuardsByBranch,Guards0,Guards1,[]),
	    param(StartState,VaridsInCommittedGuards)
	do
	    extract_guards_from_prefix(Branch, I, StartState, [], GuardInfo0, false, _UnifyFlag, End),
	    ( End == commit ->
		% remember the varids that occur in committed guards
		( foreach(guard{varid:VarId},GuardInfo0), param(VaridsInCommittedGuards) do
		    hash_set(VaridsInCommittedGuards, VarId, [])
		),
		exploit_commit(GuardInfo0, GuardInfo1)
	    ;
		GuardInfo1 = GuardInfo0
	    ),
	    sort(varid of guard, =<, GuardInfo1, GuardInfo2),
	    % remove marker entries of non-indexable guards
	    ( GuardInfo2 = [guard{varid:0}|GuardInfo] ->
		true
	    ;
		GuardInfo = GuardInfo2
	    ),
	    append(GuardInfo, Guards1, Guards0)
	),
	dim(BranchLabelArray, [NBranches]),

	% Heuristic: If any of the branches had committed guards, we
	% use for indexing only the variables that occurred in at least
	% one committed guard. This reduces the number of useless
	% indexes on what are probably output variables.
	( hash_count(VaridsInCommittedGuards, 0) ->
	    % no committed guards at all: index everything
	    UsefulGuardsByBranch = GuardsByBranch
	;
	    % filter out likely output-variables
	    (
		foreach(Guard,GuardsByBranch),
		fromto(UsefulGuardsByBranch,UGBB1,UGBB0,[]),
		param(VaridsInCommittedGuards)
	    do
		Guard = guard{varid:VarId},
	    	( hash_contains(VaridsInCommittedGuards,VarId) ->
		    UGBB1 = [Guard|UGBB0]
		;
		    UGBB1 = UGBB0
		)
	    )
	),

	% Compute the set of indexable varids and initialise
	% one index descriptor for each of them
	project_arg(varid of guard, UsefulGuardsByBranch, VarIdsMulti),
	sort(0, <, VarIdsMulti, VarIds),
	(
	    % for each indexable variable
	    foreach(VarId,VarIds),
	    foreach(VarDesc,Args),
	    foreach(index{variable:VarDesc,partition:DT},Indexes)
	do
	    % create variable access descriptor (must be done before
	    % compute_lifetimes) for use in generate_code later
	    new_vardesc(VarId, VarDesc),
	    % init the decision tree for this variable
	    dt_init(DT)
	),

	% Now incrementally build the decision trees by adding
	% each branch to each variable's decision tree.
	% PRE: UsefulGuardsByBranch are sorted first by branch, then by varid.
	(
	    % for each branch in the disjunction
	    for(I,1,NBranches),
	    fromto(UsefulGuardsByBranch,Guards1,Guards4,[]),
	    param(Indexes)
	do
	    (
		% for each indexable variable
		foreach(index{variable:variable{varid:VarId},partition:DT},Indexes),
		fromto(Guards1,Guards2,Guards3,Guards4),
		param(I)
	    do
		( Guards2 = [guard{varid:VarId,branchnr:I,class:AltClasses}|Guards3] ->
		    ( foreach(Class-Pass,AltClasses), param(I,DT) do
			( Pass=c -> Final=yes ; Final=no),
			dt_add(DT, Class, I, Final)
		    )
		;
		    % no guard for VarId in branch I
		    Guards3 = Guards2,
		    dt_add(DT, [], I, no)
		)
	    )
	),
	    
	% Evaluate and sort indexes according to quality
	( foreach(index{partition:Dt,quality:Q},Indexes) do
	    eval_index_quality(Dt, Q)
	),
	sort(quality of index, =<, Indexes, OrderedIndexes),
	eval_index_det(OrderedIndexes, NBranches, Determinism).



% Takes the goals that start the given branch, and a starting state.
% Computes a representation of the guard goals, plus a flag indicating
% whether the guard ends with or without a commit.
extract_guards_from_prefix([], _BranchNr, _StartState, Info, Info, UnifyFlag, UnifyFlag, end).
extract_guards_from_prefix([Goal|Goals], BranchNr, StartState, Info0, Info, UnifyFlag0, UnifyFlag, End) :-
	(
	    % consider only builtin predicates
	    % caution: regular preds can wake (and fail!)
	    Goal = goal{kind:simple,definition_module:sepia_kernel},
	    extract_guards_from_goal(Goal, BranchNr, StartState, UnifyFlag0, UnifyFlag1, Guard, End)
	->
	    and_guard(Guard, Info0, Info1),
	    ( var(End) ->
		extract_guards_from_prefix(Goals, BranchNr, StartState, Info1, Info, UnifyFlag1, UnifyFlag, End)
	    ;
		% end of guard detected
	    	Info = Info1, UnifyFlag = UnifyFlag0
	    )

	; Goal = goal{kind:head,state:HeadState} ->
	    % Use the head's binding information instead of what was known
	    % prior to the disjunction
	    extract_guards_from_prefix(Goals, BranchNr, HeadState, Info0, Info, UnifyFlag0, UnifyFlag, End)
%	    extract_guards_from_prefix(Goals, BranchNr, StartState, Info0, Info, UnifyFlag0, UnifyFlag, End)

	; Goal = disjunction{branches:[SubBranch1|SubBranches]} ->
	    % look into the prefixes of the branches
	    extract_guards_from_prefix(SubBranch1, BranchNr, StartState, [], SubInfo1, UnifyFlag0, UnifyFlag1, _End),
	    (
		foreach(SubBranch,SubBranches),
		fromto(SubInfo1,SubInfo2,SubInfo4,SubInfo),
		fromto(UnifyFlag1,UnifyFlag2,UnifyFlag3,UnifyFlag),
		param(BranchNr,StartState, UnifyFlag0)
	    do
		extract_guards_from_prefix(SubBranch, BranchNr, StartState, [], SubInfo3, UnifyFlag0, UnifyFlagI, _End),
		or_guards(SubInfo2, SubInfo3, SubInfo4),
		or_flags(UnifyFlagI, UnifyFlag2, UnifyFlag3)
	    ),
	    and_guards(Info0, SubInfo, Info),
	    End = end	% not sure about the scope of commits in sub-branches
	;
	    % end of guard
	    Info = Info0, UnifyFlag = UnifyFlag0, End = end
	).


% PRE: the goal is a builtin from sepia_kernel.
% Fail if encountering a goal that signals end-of-guard.
% Regular goal can cause waking (and therefore insert failures).
% StartState is the analysis state at the beginning of the disjunction.
% UnifyFlag is true if goals between switch and the current goal might
% have unified any switch variables (and thus weakened the guards).
% Additionally, we set UnifyFlagAfter iff the current goal can unify a
% switch variable (and thus weaken the switch conditions for subsequent guards).

extract_guards_from_goal(goal{functor:get_cut/1},
		_BranchNr, _StartState, UnifyFlag, UnifyFlag, true, _) :- !.

extract_guards_from_goal(goal{functor:cut_to/1},
		_BranchNr, _StartState, UnifyFlag, UnifyFlag, true, commit) :- !.

extract_guards_from_goal(goal{functor:(=)/2, args:[Lhs,Rhs], state:GoalState},
		BranchNr, StartState, _UnifyFlag, UnifyFlagAfter, Guard, _) :- !,
	% unifications should be normalised and always
	% have a variable on the left hand side
	certainly_once Lhs = variable{varid:VarId},
	% state_lookup_binding should succeed iff the variable was known
	% before the start of the disjunction
	( state_lookup_binding(StartState, VarId, _Binding) ->
	    ( atomic_tag(Rhs, Tag) ->
		( value_indexable(Tag) ->
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[Tag,Rhs]-t]}
		; single_value(Tag) ->
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[Tag]-t]}
		;
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[Tag]-m]}
		)
	    ; Rhs = structure{name:F,arity:A,args:Args} ->
		(all_fresh_vars(Args, A, GoalState) -> PassFlag=t ; PassFlag=m ),
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[structure,F/A]-PassFlag]}
	    ; Rhs = [A1|A2] ->
		(all_fresh_vars([A1,A2], 2, GoalState) -> PassFlag=t ; PassFlag=m ),
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[list]-PassFlag]}
	    ; Rhs = variable{varid:VarId} ->
		% an X=X dummy goal
		Guard = true
	    ; verify Rhs = variable{},
		%%% REVIEW: classes should be disjoint
%		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[]-m,[var]-t]}
%		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[]-m]}
		Guard = guard{branchnr:BranchNr,varid:0,class:[]}
	    ),
	    % Conservatively assume that the goal may (directly, via aliasing,
	    % or via occurrences in the Rhs) unify this or another switch variable
	    UnifyFlagAfter = true
	    % This could be more precise, using binding information:
	    % A = X				false
	    % A = f(X,X)			false
	    % X = f(A,B)	with inst(X)	false
	    % X = f(A,B)	with univ(X)	true
	    % X = f(A,A)			true
	    % X = f(Y)			true
	    % X = f(a)			true
	    % X = f(g(_))			true
	    %	state_lookup_binding(GoalState, VarId, LhsBinding),
	    %	( binding_inst(LhsBinding) -> \+all_fresh_term(Rhs) ; true ).
	;
	    % Nothing known about the variable at switch time, so it can't be
	    % used for indexing. Check whether it can fail at call time.
	    ( state_lookup_binding(GoalState, VarId, _Binding) ->
		% insert marker for possibly failing goal
		Guard = guard{branchnr:BranchNr,varid:0,class:[]},
		% Conservatively assume that the goal may (via aliasing or
		% occurrences in Rhs) unify another switch variable
		UnifyFlagAfter = true
	    ;
		% a fresh variable, goal will always succeed
		Guard = true,
		% No danger of the guard unifying a switch variable
		UnifyFlagAfter = false
	    )
	).

extract_guards_from_goal(goal{functor:(==)/2, args:[Lhs,Rhs]},
		BranchNr, StartState, UnifyFlag, UnifyFlag, Guard, _) :- !,
	( Lhs = variable{varid:VarId}, Rhs \= variable{} ->
	    extract_guards_from_identity(VarId, Rhs, BranchNr, StartState, UnifyFlag, Guard)
	; Rhs = variable{varid:VarId}, Lhs \= variable{} ->
	    extract_guards_from_identity(VarId, Lhs, BranchNr, StartState, UnifyFlag, Guard)
	; Lhs = variable{varid:VarId}, Rhs = variable{varid:VarId} ->
	    Guard = true
	;
	    % goal may fail, but can't be used for indexing
	    Guard = guard{branchnr:BranchNr,varid:0,class:[]}
	).

extract_guards_from_goal(goal{functor:(?=)/2, args:[Lhs,Rhs], state:GoalState},
		BranchNr, StartState, UnifyFlag, UnifyFlag, Guard, _) :- !,
	% matchings should not be preceded by unifications
	verify UnifyFlag == false,
	% matchings should be normalised and always
	% have a variable on the left hand side
	certainly_once Lhs = variable{varid:VarId},
	% state_lookup_binding should succeed iff the variable was known
	% before the start of the disjunction
	( state_lookup_binding(StartState, VarId, _Binding) ->
	    ( atomic_tag(Rhs, Tag) ->
		( value_indexable(Tag) ->
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag,Rhs]-t]}
		; single_value(Tag) ->
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-t]}
		;
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-m]}
		)
	    ; Rhs = attrvar{} ->
		% TODO fresh vars check
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var,meta]-m]}
	    ; Rhs = structure{name:F,arity:A,args:Args} ->
		(all_fresh_vars(Args, A, GoalState) -> PassFlag=t ; PassFlag=m ),
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[structure,F/A]-PassFlag]}
	    ;
		Rhs = [A1|A2],
		(all_fresh_vars([A1,A2], 2, GoalState) -> PassFlag=t ; PassFlag=m ),
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[list]-PassFlag]}
	    )
	;
	    % This can happen if the lhs was an output mode (-) argument
	    warning("Output mode (-) overrides matching clause semantics"),
	    Guard = true
	).

extract_guards_from_goal(goal{
    		functor:Test/1, args:[variable{varid:VarId}] },
		BranchNr, StartState, UnifyFlag, UnifyFlag, Guard, _) :-
	type_test(Test, TestClasses),
	!,
	( state_lookup_binding(StartState, VarId, _Binding) ->
	    binding_effect_on_guard(UnifyFlag, TestClasses, Classes),
	    Guard = guard{branchnr:BranchNr,varid:VarId,class:Classes}
	;
	    % nothing known about the variable,
	    % goal may fail, but can't be used for indexing
	    % (we could probably be more precise here)
	    Guard = guard{branchnr:BranchNr,varid:0,class:[]}
	).

    % For the ==/2 predicate, matching, etc
    extract_guards_from_identity(VarId, Rhs, BranchNr, StartState, UnifyFlag, Guard) :-
	% state_lookup_binding should succeed iff the variable was known
	% before the start of the disjunction
	( state_lookup_binding(StartState, VarId, _Binding) ->
	    % Binding after switch can make guard true in var case!
	    binding_effect_on_guard(UnifyFlag, [], VarClass),
	    ( atomic_tag(Rhs, Tag) ->
		( value_indexable(Tag) ->
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag,Rhs]-t|VarClass]}
		; single_value(Tag) ->
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-t|VarClass]}
		;
		    Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-m|VarClass]}
		)
	    ; Rhs = structure{name:F,arity:A} ->
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[structure,F/A]-m|VarClass]}
	    ; verify Rhs = [_|_],
		Guard = guard{branchnr:BranchNr,varid:VarId,class:[[list]-m|VarClass]}
	    )
	;
	    % nothing known about the variable at switch time, can't be used for indexing,
	    Guard = guard{branchnr:BranchNr,varid:0,class:[]}
	).


% The tags that have switch_on_value instructions
:- mode value_indexable(+).
value_indexable(integer).
value_indexable(atom).
value_indexable(structure).


single_value([]).


% Compute the tag of a value
:- mode atomic_tag(+,-).
atomic_tag(X, bignum) :- sepia_kernel:bignum(X), !.
atomic_tag(X, integer) :- integer(X).
atomic_tag([], '[]') :- !.
atomic_tag(X, atom) :- atom(X).
atomic_tag(X, breal) :- breal(X).
atomic_tag(X, double) :- float(X).
atomic_tag(X, rational) :- rational(X).
atomic_tag(X, handle) :- is_handle(X).	% can't occur in textual source
atomic_tag(X, string) :- string(X).


% Compute the tag sets resulting from various type tests
% Also set the pass-flag:
%	t	with this tag the test is definitely satisfied
%	m	with this tag the test may be satisfied
type_test(atom,		[[atom]-t,[[]]-t]).
type_test(atomic,	[[[]]-t,[atom]-t,[bignum]-t,[breal]-t,[goal]-t,[double]-t,[handle]-t,[integer]-t,[rational]-t,[string]-t]).
type_test(bignum,	[[bignum]-t]).
type_test(breal,	[[breal]-t]).
type_test(callable,	[[[]]-t,[atom]-t,[list]-t,[structure]-t]).
type_test(compound,	[[list]-t,[structure]-t]).
type_test(float,	[[double]-t]).
type_test(free,		[[var,free]-t]).
type_test(ground,	[[[]]-t,[atom]-t,[bignum]-t,[breal]-t,[goal]-t,[list]-m,[structure]-m,[double]-t,[handle]-t,[integer]-t,[rational]-t,[string]-t]).	% not only tag test
type_test(integer,	[[bignum]-t,[integer]-t]).
type_test(is_event,	[[atom]-m,[handle]-m]).	% not only tag test!
type_test(is_handle,	[[handle]-t]).
type_test(is_array,	[[[]]-t,[structure]-m]).	% not only tag test!
type_test(is_list,	[[[]]-t,[list]-m]).	% not only tag test!
type_test(is_suspension, [[goal]-m]).		% not only tag test!
type_test(meta,		[[var,meta]-t]).
type_test(nonground,	[[var]-t,[list]-m,[structure]-m]).	% not only tag test
type_test(nonvar,	[[[]]-t,[atom]-t,[bignum]-t,[breal]-t,[goal]-t,[list]-t,[structure]-t,[double]-t,[handle]-t,[integer]-t,[rational]-t,[string]-t]).
type_test(number,	[[bignum]-t,[breal]-t,[double]-t,[integer]-t,[rational]-t]).
type_test(rational,	[[rational]-t]).
type_test(real,		[[breal]-t,[double]-t]).
type_test(string,	[[string]-t]).
type_test(var,		[[var]-t]).


% A unification of the switch-argument in between the switch and the
% guard test can make the guard true in the var-case as well.
binding_effect_on_guard(true, TestClasses, Classes) ?-
	or_classes(TestClasses, [[var]-m], Classes).
binding_effect_on_guard(false, Classes, Classes).


and_guards(Guards1, Guards2, Guards) :-
	(
	    foreach(Guard,Guards1),
	    fromto(Guards2,Guards3,Guards4,Guards)
	do
	    and_guard(Guard, Guards3, Guards4)
	).


% OldGuards is a list containing at most one guard{} for each VarId
% Guard is a guard{} for a particular VarId
and_guard(true, Guards, Guards).
and_guard(Guard, OldGuards, NewGuards) :-
	Guard = guard{branchnr:BranchNr,varid:VarId,class:Classes},
	% lookup and replace guard for BranchNr and VarId
	OldGuard = guard{branchnr:BranchNr,varid:VarId,class:OldClasses},
	( selectchk(OldGuard, OldGuards, NewGuard, NewGuards) ->
	    NewGuard = guard{branchnr:BranchNr,varid:VarId,class:NewClasses},
	    and_classes(Classes, OldClasses, NewClasses)
	;
	    NewGuards = [Guard|OldGuards]
	).


% Compute the conjunctions of the guards, represented as class lists.
% Class lists are supposed to contain disjoint, alternative classes.
and_classes(Ls, Rs, Cs) :-
	(
	    foreach(LClass-LPass,Ls) * foreach(RClass-RPass,Rs),
	    fromto(Cs,Cs1,Cs0,[])
	do
	    ( and_class(LClass,RClass,Class) ->
		and_pass(LPass, RPass, Pass),
		Cs1 = [Class-Pass|Cs0]
	    ;
		Cs1 = Cs0
	    )
	).


    % guard passing only guaranteed if both guards are guaranteed to pass
    and_pass(t, t, t) :- !.
    and_pass(_, _, m).


    % keep the more specific class only. e.g. [atom,a] * [atom] -> [atom,a]
    % fail if classes are incomparable
    and_class(L, R, C) :-
    	( append(L, _, R) ->	% L is the prefix
	    C = R
    	; append(R, _, L) ->	% R is the prefix
	    C = L
	).


or_guards(Guards1, Guards2, OrGuards) :-
	(
	    foreach(guard{varid:VarId,branchnr:BNr,class:Class1},Guards1),
	    fromto(Guards2,Guards3,Guards4,_),
	    fromto(OrGuards,OrGuards1,OrGuards2,[])
	do
	    ( VarId \== 0, delete(guard{varid:VarId,branchnr:BNr,class:Class2},Guards3,Guards4) ->
		or_classes(Class1, Class2, OrClass),
		OrGuards1 = [guard{varid:VarId,branchnr:BNr,class:OrClass}|OrGuards2]
	    ;
		Guards3 = Guards4, OrGuards1 = OrGuards2
	    )
	).


% Compute the disjunction of the guards, represented as class lists.
% Class lists are supposed to contain disjoint, alternative classes.
or_classes(Ls, Rs, Cs) :-
	sort(1, =<, Ls, Ls1),
	sort(1, =<, Rs, Rs1),
	merge(1, =<, Ls1, Rs1, Cs0),
	( Cs0 = [C1|Cs1] ->
	    (
		fromto(C1,C0,C,Cn),
		fromto(Cs1,[C2|Cs2],Cs2,[]),
		fromto(Cs,Cs3,Cs4,[Cn])
	    do
		( class_subsumes(C0, C2, C) ->
		    Cs3 = Cs4			% drop C2
		;
		    Cs3 = [C0|Cs4], C = C2
		)
	    )
	;
	    Cs = Cs0
	).

    class_subsumes(LC-LP, RC-RP, LC-P) :-
    	append(LC, Rest, RC),
	( Rest == [] ->
	    or_pass(LP, RP, P)	% LC==RC: choose stronger pass flag
	;
	    P = LP	% LC-LP
	).

    or_pass(t, _, t) :- !.
    or_pass(_, t, t) :- !.
    or_pass(_, _, m).


or_flags(false, false, false) :- !.
or_flags(false, true, true) :- !.
or_flags(true, false, true) :- !.
or_flags(true, true, true) :- !.


% Check whether Args is a list of disjoint fresh variables
all_fresh_vars(Args, Arity, State) :-
	(
	    foreach(variable{varid:VarId},Args),
	    foreach(VarId,VarIds),
	    param(State)
	do
	    \+ state_lookup_binding(State, VarId, _Binding)
	),
	sort(VarIds, UniqVarIds),
	length(UniqVarIds, Arity).


% Succeed iff term does not contain old variables or internal aliasing
all_fresh_term(Term, _State) :- atomic(Term).
all_fresh_term(structure{arity:Arity,args:Args}, State) ?- !,
	all_fresh_vars(Args, Arity, State).
all_fresh_term([A1|A2], State) ?- !,
	all_fresh_vars([A1,A2], 2, State).
all_fresh_term(variable{varid:VarId}, State) ?- !,
	\+ state_lookup_binding(State, VarId, _Binding).
%all_fresh_term(attrvar{}, _State) ?- fail.


% If we had only one guarded variable followed by commit,
% we change its pass-markers from -t to -c to indicate that
% any subsequent branches cannot be reached for these classes.
exploit_commit([Guard0], [Guard]) :- !,
	Guard0 = guard{class:Classes0},
	update_struct(guard, class:Classes, Guard0, Guard),
	(
	    foreach(Class-Pass0,Classes0),
	    foreach(Class-Pass,Classes)
	do
	    ( Pass0=t -> Pass=c ; Pass=Pass0 )
	).
exploit_commit(GuardInfo, GuardInfo).



% Evaluate index quality: A positive float, the smaller the better.
% Roughly computes fan-out (number of alternatives jumped to)
% divided by fan-in (number of different argument values tested for).

eval_index_quality(Dt, Q) :-	
	% collect all occurring sets of alternatives
	dt_values(Dt, Branches0),
	( dt_lookup2(Dt, [var], _, _) ->
	    Branches = Branches0
	;
	    Branches = [[]|Branches0]
	),
	% remove duplicate sets
	sort(Branches, BranchesSets),
	(
	    foreach(BranchesSet,BranchesSets) >> foreach(_,BranchesSet),
	    count(_,1,NTargetBranches)
	do
	    true
	),
	% This is the quality measure
	Q is NTargetBranches/length(BranchesSets).


%
% Compute determinacy information after indexing analysis
% (we only look at the first index, and assume it is going to be
% implemented accurately by the generated indexing code)
%
% BranchDets: For each branch of the disjunction, which position it can take:
%	det - never one of several matching alternatives
%	try - always the first of several matching alternatives
%	trust - always the last of several matching alternatives
%	retry - can be anywhere in try sequence
%	failure - never matches (dead code)
%
% DisjDet: The whole disjunction is classified as:
%	semidet - if it never creates a choicepoint
%	nondet - otherwise
%

eval_index_det([index{partition:Dt}|_], NBranches, BranchDets) :- !,
	dt_list(Dt, Parts),
	hash_create(NonLasts),
	hash_create(Dets),
	hash_create(NonFirsts),
	(
	    foreach(_Key-Branches,Parts),
	    param(NonLasts,Dets,NonFirsts)
	do
	    ( Branches = [] ->
		true
	    ;
	    	Branches = [B1|Bs],
		( Bs = [] ->
		    hash_set(Dets, B1, true)
		;
		    hash_set(NonLasts, B1, true),
		    ( fromto(Bs,[Bi|Bs1],Bs1,[Bn]), param(NonFirsts,NonLasts) do
			hash_set(NonFirsts, Bi, true),
			hash_set(NonLasts, Bi, true)
		    ),
		    hash_set(NonFirsts, Bn, true)
		)
	    )
	),
	dim(BranchDets, [NBranches]),
	( foreacharg(BranchDet,BranchDets,I), param(NonLasts,Dets,NonFirsts) do
	    ( hash_contains(NonFirsts, I) ->
		( hash_contains(NonLasts, I) ->
		    BranchDet = retry
		;
		    BranchDet = trust
		)
	    ; hash_contains(NonLasts, I) ->
		BranchDet = try
	    ; hash_contains(Dets, I) ->
		BranchDet = det
	    ;
		BranchDet = failure
	    )
	).
eval_index_det([], NBranches, BranchDets) :-
	verify NBranches >= 2,
	dim(BranchDets, [NBranches]),
	arg(1, BranchDets, try),
	arg(NBranches, BranchDets, trust),
	( for(I,2,NBranches-1), param(BranchDets) do
	    arg(I, BranchDets, retry)
	).


% Debugging: print readable summary of index

dump_indexes(disjunction{callpos:CallPos,determinism:BranchDets,indexes:Indexes}, options{print_indexes:Flag}) :-
	( Flag==on, Indexes = [_|_] ->
	    ( foreacharg(BrDet,BranchDets), fromto(semidet,Det1,Det2,Det) do
	    	( (BrDet==det;BrDet==failure) -> Det2=Det1 ; Det2=nondet )
	    ),
	    printf("INDEXES for (%w) disjunction %w%n", [Det,CallPos]),
	    (
		count(I,1,_),
%		foreach(index{quality:Q,variable:variable{varid:VarId},partition:Dt},Indexes)
		foreach(index{quality:Q,partition:Dt},Indexes)
	    do
		Q1 is round(10*Q)/10,	% printf's rounding is unreliable
%		printf("%d. Quality %.1f, variable %d%n", [I,Q1,VarId]),
		printf("%d. Quality %.1f%n", [I,Q1]),
		dt_list(Dt, Parts0), 
		keysort(Parts0, Parts),	% for reproducible output
		( foreach(Part,Parts) do
		    printf("    %w%n", [Part])
		)
	    ),
	    printf("Branch determinisms for disjunction %w%n", [CallPos]),
	    ( foreacharg(BranchDet,BranchDets,I) do
		printf("    Branch %d: %w%n", [I,BranchDet])
	    )
	;
	    true
	).
