/*-------------------------------------------------------------------------*/
/* GNU Prolog                                                              */
/*                                                                         */
/* Part  : Prolog to WAM compiler                                          */
/* File  : indexing.pl                                                     */
/* Descr.: indexing code generation                                        */
/* Author: Daniel Diaz                                                     */
/*                                                                         */
/* Copyright (C) 1999 Daniel Diaz                                          */
/*                                                                         */
/* GNU Prolog is free software; you can redistribute it and/or modify it   */
/* under the terms of the GNU General Public License as published by the   */
/* Free Software Foundation; either version 2, or any later version.       */
/*                                                                         */
/* GNU Prolog is distributed in the hope that it will be useful, but       */
/* WITHOUT ANY WARRANTY; without even the implied warranty of              */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU        */
/* General Public License for more details.                                */
/*                                                                         */
/* You should have received a copy of the GNU General Public License along */
/* with this program; if not, write to the Free Software Foundation, Inc.  */
/* 59 Temple Place - Suite 330, Boston, MA 02111, USA.                     */
/*-------------------------------------------------------------------------*/

/*-------------------------------------------------------------------------*/
/* Level 1:                                                                */
/*                                                                         */
/* The clauses C1,...,Cn of a predicate Pred are split into groups         */
/* G0,...,Gm so that each group Gi:                                        */
/*                                                                         */
/*   a) contains only one clause whose 1st arg is a variable.              */
/*   b) contains only clauses whose 1st arg is not a variable.             */
/*                                                                         */
/* The following code is then produced:                                    */
/*                                                                         */
/*   L0: try_me_else(L1)                                                   */
/*       <code for G0>                                                     */
/*                                                                         */
/*   L1: retry_me_else(L2)                                                 */
/*       <code for G1>                                                     */
/*            :                                                            */
/*            :                                                            */
/*   Lm: trust_me_else_fail                                                */
/*       <code for Gm>                                                     */
/*                                                                         */
/* Level 2:                                                                */
/*                                                                         */
/* For a group Gi whose type is a), the <code for Gi> only contains the    */
/* code produced for the associated Ck clause.                             */
/* For a group Gi whose type is b), the <code for Gi> contains indexing    */
/* instructions for the level 2 to discriminate between atoms, integers    */
/* lists and structures as follows:                                        */
/*                                                                         */
/*            switch_on_term(LabVar,LabAtm,LabInt,LabLst,LabStc)           */
/*                                                                         */
/*   LabFail: fail                 if there is a LabXxx = LabFail          */
/*                                                                         */
/*   LabAtm : switch_on_atom(N,[(atm1,LabAtm1),...(atmN,LabAtmN)])       \ */
/*                                                                       | */
/*   LabAtmj: try(Adj1)                  \  if more than 1 clause has    | */
/*            retry(Adj2) if more than 2 |  atmj as 1st arg,             | */
/*              :                        |  else LabAtmj = Adj1          | */
/*            trust(Adjk)                /                               | */
/*                                 if there are atms, else LabAtm=LabFail/ */
/*   idem for switch_on_integer                                            */
/*                                                                         */
/*   LabLst : try(Adj1)                  \  if more than 1 clause has    | */
/*            retry(Adj2) if more than 2 |  [_|_] as 1st arg,            | */
/*              :                        |  else LabLst = Adj1           | */
/*            trust(Adjk)                /                               | */
/*                                 if there are lsts, else LabLst=LabFail/ */
/*                                                                         */
/*   LabStc : switch_on_structure(N,[(stc1,LabStc1),...(stcN,LabStcN)])  \ */
/*                                                                       | */
/*   LabStcj: try(Adj1)                  \  if more than 1 clause has    | */
/*            retry(Adj2) if more than 2 |  stcj as 1st arg,             | */
/*              :                        |  else LabStcj = Adj1          | */
/*            trust(Adjk)                /                               | */
/*                                 if there are stcs, else LabStc=LabFail/ */
/*                                                                         */
/*   LabVar:  try_me_else(LabVar2) if there are more than 1 clause in Gi,  */
/*   Ad1:     <code for clause 1>  else LabVar = Ad1                       */
/*                                                                         */
/*   LabVar2: retry_me_else(LabVar3)                                       */
/*   Ad2:     <code for clause 2>                                          */
/*                :                                                        */
/*                :                                                        */
/*   LabVarp: trust_me_else_fail                                           */
/*   Adp:     <code for clause p>                                          */
/*                                                                         */
/* LCC: [cl(Ad,FirstArg,WamCl), ...] list of compiled clauses for Pred.    */
/*                                                                         */
/*       Ad      : will contain (in level 2) the label associated to WamCl */
/*                 (initially Ad is an unbound variable).                  */
/*       FirstArg: the first argument of the source clause.                */
/*       WamCl   : [wam_inst, ...] clause wam code.                        */
/*                                                                         */
/* look_for_var partitions LCC in LCCBefore, CCVar and LCCAfter and detects*/
/* the current case:                                                       */
/*                                                                         */
/*   1...) a variables has been found (thus level 1), sub-cases:           */
/*    11) LCCBefore<>[] and LCCAfter<>[]  12) LCCBefore<>[] and LCCAfter=[]*/
/*    13) LCCBefore= [] and LCCAfter<>[]  14) LCCBefore= [] and LCCAfter=[]*/
/*                                                                         */
/*   2) no variables (thus level 2).                                       */
/*                                                                         */
/* other used variables:                                                   */
/*                                                                         */
/* Lev1: has any try/retry/trust_me_else been generated for level 1 (t/f)? */
/* Atm : [a(atm,[Ad, ...]), ...]                                           */
/* Int : [a(int,[Ad, ...]), ...]                                           */
/* Lst : [Ad, ...]                                                         */
/* Stc : [a(f/n,[Ad, ...]), ...]                                           */
/* List: Atm, Int, or Stc for general processings                          */
/*                                                                         */
/* Note on labels:                                                         */
/*    Labels are consecutive integers from 1 to n without "holes".         */
/*    Each label is first referenced and later defined.                    */
/*-------------------------------------------------------------------------*/

indexing(LCC,WamCode1):-
	indexing1(LCC,f,_,[_|WamCode]),    % ignore the first unused label(0)
	cur_pred(Pred,N),
	(test_pred_info(cut,Pred,N)
            -> WamCode1=[load_cut_level(N)|WamCode]
            ;  WamCode1=WamCode),
	allocate_labels(WamCode1,1,_).




indexing1(LCC,Lev1,Lab,[label(Lab)|WamCode]):-
	look_for_var(LCC,Case,LCCBefore,CCVar,LCCAfter),
	mk_indexing(Case,LCCBefore,CCVar,LCCAfter,Lev1,WamCode),
	!.




look_for_var([],2,[],_,[]).

look_for_var([cl(Ad,var,WamCl)|LCC],Case,[],cl(Ad,var,WamCl),LCC):-
	!,
	(LCC=[] -> Case=14
	        ;  Case=13).

look_for_var([CC|LCC],Case1,[CC|LCCBefore],CCVar,LCCAfter):-
	look_for_var(LCC,Case,LCCBefore,CCVar,LCCAfter),
	(Case=13 -> Case1=11
 	         ;  (Case=14 -> Case1=12
	                     ;  Case1=Case)).




mk_indexing(11,LCCBefore,cl(_,_,WamCl),LCCAfter,Lev1,WamCode):-
	(Lev1=f -> TmRmTm=try_me_else(Lab)
	        ;  TmRmTm=retry_me_else(Lab)),
	mk_indexing(2,LCCBefore,_,_,f,WamBefore),
	indexing1(LCCAfter,t,Lab1,WamAfter),
	WamCode=[TmRmTm,WamBefore,label(Lab),retry_me_else(Lab1),WamCl|WamAfter].

mk_indexing(12,LCCBefore,cl(_,_,WamCl),_,Lev1,WamCode):-
	(Lev1=f -> TmRmTm=try_me_else(Lab)
	        ;  TmRmTm=retry_me_else(Lab)),
	mk_indexing(2,LCCBefore,_,_,f,WamBefore),
	WamCode=[TmRmTm,WamBefore,label(Lab),trust_me_else_fail|WamCl].

mk_indexing(13,_,cl(_,_,WamCl),LCCAfter,Lev1,WamCode):-
	(Lev1=f -> TmRmTm=try_me_else(Lab)
	        ;  TmRmTm=retry_me_else(Lab)),
	indexing1(LCCAfter,t,Lab,WamAfter),
	WamCode=[TmRmTm,WamCl|WamAfter].

mk_indexing(14,_,cl(_,_,WamCl),_,Lev1,WamCode):-
	(Lev1=f -> WamCode=WamCl 
	        ;  WamCode=[trust_me_else_fail|WamCl]).

mk_indexing(2,LCC,_,_,Lev1,WamCode):-
	(Lev1=f -> WamCode=[switch_on_term(LabVar,LabAtm,LabInt,
	                                   LabLst,LabStc)|WamCode1]
	        ;  WamCode=[trust_me_else_fail,
	                    switch_on_term(LabVar,LabAtm,LabInt,
	                                   LabLst,LabStc)|WamCode1]),
	split(LCC,Atm,Int,Lst,Stc),
	!,
	(Atm=[]  -> LabAtm=LabFail, Fail=t
	         ;  true),
	(Int=[]  -> LabInt=LabFail, Fail=t
	         ;  true),
	(Lst=[]  -> LabLst=LabFail, Fail=t
	         ;  true),
	(Stc=[]  -> LabStc=LabFail, Fail=t
	         ;  true),
	(Fail==t -> WamCode1=WamSwtAtm,  % or WamCode1=[label(LabFail),fail|
                    LabFail=fail         %              WamSwtAtm] 
	         ;
		    WamCode1=WamSwtAtm),
	gen_switch(Atm,switch_on_atom,LabAtm,WamSwtInt,WamSwtAtm),
	gen_switch(Int,switch_on_integer, LabInt,WamLst,WamSwtInt),   
	gen_list(Lst,LabLst,WamSwtStc,WamLst),                        
	gen_switch(Stc,switch_on_structure,LabStc,WamCode2,WamSwtStc),
	gen_insts(LCC,LabVar,WamCode2).




split(LCC,Atm1,Int1,Lst,Stc1):- 
	split1(LCC,[],[],a(End,End),[],Atm,Int,a([],Lst),Stc),
	terminate_list(Atm,Atm1),
	terminate_list(Int,Int1),
	terminate_list(Stc,Stc1).


split1([],Atm,Int,Lst,Stc,Atm,Int,Lst,Stc).

split1([cl(Ad,FirstArg,_)|LCC],Atm,Int,Lst,Stc,Atm2,Int2,Lst2,Stc2):-
	split2(FirstArg,Ad,Atm,Int,Lst,Stc,Atm1,Int1,Lst1,Stc1),
	split1(LCC,Atm1,Int1,Lst1,Stc1,Atm2,Int2,Lst2,Stc2).


split2(atm(A),Ad,Atm,Int,Lst,Stc,Atm1,Int,Lst,Stc):-
	add_to_list(Atm,A,Ad,Atm1).

split2(int(N),Ad,Atm,Int,Lst,Stc,Atm,Int1,Lst,Stc):-
	add_to_list(Int,N,Ad,Int1).

split2(lst,Ad,Atm,Int,a([Ad|End],LAd),Stc,Atm,Int,a(End,LAd),Stc).

split2(stc(F,N),Ad,Atm,Int,Lst,Stc,Atm,Int,Lst,Stc1):-
	add_to_list(Stc,F/N,Ad,Stc1).




add_to_list([],F,Ad,[a(F,End,[Ad|End])]).

add_to_list([a(F,[Ad|End],LAd)|List],F,Ad,[a(F,End,LAd)|List]):-
	!.

add_to_list([X|List],F,Ad,[X|List1]):-
	add_to_list(List,F,Ad,List1).




terminate_list([],[]).

terminate_list([a(F,[],LAd)|L],[a(F,LAd)|L1]):-
	terminate_list(L,L1).




gen_switch([],_,_,LNext,LNext):-
	!.

    % if only 1 element with only 1 clause, no switch (remove if needed)

gen_switch([a(_,[Ad])],_,Ad,LNext,LNext):-
	!.

    % if only 1 element with n clauses, no switch (remove if needed)
/*
gen_switch([a(_,LAd)],_,Lab,LNext,WamTRT):-
	!,
	gen_list(LAd,Lab,LNext,WamTRT).
*/
gen_switch(List,Ins,Lab,LNext,[label(Lab),SwtW|WamTRT]):-
	create_switch_list(List,LSwt,LNext,WamTRT),
	SwtW=..[Ins,LSwt].




create_switch_list([],[],LNext,LNext).

create_switch_list([a(F,LAd)|List],[(F,Lab)|LSwt],LNext,WamTRT):-
	gen_list(LAd,Lab,WamTRT1,WamTRT),
	create_switch_list(List,LSwt,LNext,WamTRT1).




gen_list([],_,LNext,LNext).

gen_list([Ad],Ad,LNext,LNext):-                   % only 1 Atmj, Lst or Stcj
	!.

gen_list([Ad|LAd],Lab,LNext,WamRT1):-             % 2..n
	WamRT1=[label(Lab),try(Ad)|WamRT],
	gen_list1(LAd,LNext,WamRT).


gen_list1([Ad],LNext,[trust(Ad)|LNext]).

gen_list1([Ad|LAd],LNext,WamRT1):-
	WamRT1=[retry(Ad)|WamRT],
	gen_list1(LAd,LNext,WamRT).




gen_insts([cl(Ad,_,WamCl)],Ad,[label(Ad)|WamCl]):-    % only 1 clause
	!.
	
gen_insts([cl(Ad,_,WamCl)|LCC],Lab,WamCode2):-        % 2..n
	gen_insts1(LCC,Lab1,WamCode),
	WamCode2=[label(Lab),try_me_else(Lab1),label(Ad),WamCl|WamCode].



gen_insts1([cl(Ad,_,WamCl)],Lab,[label(Lab),trust_me_else_fail,label(Ad)|WamCl]):-
	!.

gen_insts1([cl(Ad,_,WamCl)|LCC],Lab,WamCode2):-
	gen_insts1(LCC,Lab1,WamCode),
	WamCode2=[label(Lab),retry_me_else(Lab1),label(Ad),WamCl|WamCode].




allocate_labels([],N,N):-
	!.

allocate_labels([WamInst1|WamInst2],N,N2):-
	!,
	allocate_labels(WamInst1,N,N1),                % for nested lists
	allocate_labels(WamInst2,N1,N2).

allocate_labels(label(N),N,N1):-
	!,
	N1 is N+1.

allocate_labels(_,N,N).
