/*****************************************************************
Time-stamp: <2008-10-29 10:41:19 banbara>

NAME
       pl2am: Translating Prolog into WAM-based Intermediate Code

USAGE
       # sicstus
       ?- [pl2am].   
       ?- pl2am([File1, File2, [Op1,..,OpN]]).

PARAMETERS
       File1 is an input prolog file name.
       File2 is an output file name.
       Op    ::= ed | ac | ie | rc | idx | clo
          ed : eliminate disjunctions
          ac : arithmetic compilation
          ie : inline expansion
          rc : optimise recursive call
          idx: switch_on_hash (2nd. level indexing)
          clo: generate closure for meta predicates

DESCRIPTION
       This program translates Prolog program into WAM-based intermediate codes.
       Generated codes can be translated into Java program by using am2j.pl,
       and then compiled and executed by usual java utilities 
       with the Prolog Cafe runtime system.

COPYRIGHT
       pl2am (Translating Prolog into WAM-based Intermediate Code)
       Copyright (C) 1997-2008 by 
          Mutsunori Banbara (banbara@kobe-u.ac.jp) and
          Naoyuki Tamura (tamura@kobe-u.ac.jp)

SEE ALSO
       http://kaminari.istc.kobe-u.ac.jp/PrologCafe/
*****************************************************************/

/*****************************************************************
             WAM-BASED INTERMEDIATE INSTRUCTIONS

Put Instructions
================
  put_var(X)
  put_int(i, X)
  put_float(f, X)
  put_con(f/n, X)
  put_con(c, X), 
  put_list(Xi, Xj, Xk)
  put_str(Xi, Y, Xj)
  put_str_args([Xi,..,Xn], Y)
  put_clo(p:G, X)
  put_cont(p:BinG, C)
  put_cont(BinG, C)

Get Instructions
================
  get_val(Xi, Xj)
  get_int(i, Xi, Xj)
  get_float(f, Xi, Xj)
  get_con(c, Xi, Xj)
  get_ground(g, Xi, Xj)
  get_list(X)
  get_str(f/n, Xi, Xj)

Unify Instructions
==================
  unify_var(X)
  unify_val(X)
  unify_int(i, X)
  unify_float(f, X)
  unify_con(c, X)
  unify_ground(g, X)
  unify_void(i)

Choice Instructions
===================
  try(Li, Lj)
  retry(Li, Lj)
  trust(L)

Indexing Instructions
=====================
  switch_on_term(Lv, Li, Lf, Lc, Ls, Ll)
  switch_on_hash(TAG, i, L, hashtable)

Control Instructions
====================
  execute(p:BinG)
  execute(BinG)
  inline(G)

Other Instructions
==================
  (:- G)

  comment(Message)
  debug(Message)
  info(Message)

  begin_predicate(p, f/n)
  end_predicate(p, f/n)

  import_package(p)
  import_package(p, f/n)

  main(f/n, public): [Instructions]
  main(f/n, non-public): [Instructions]
  L: [Instructions]

  label(L)
  deref(Ri, Rj)
  set(Ri, Rj)
  setB0
  goto(L)

  decl_term_vars([R1,...,Rn])
  decl_pred_vars([R1,...,Rn])

  new_hash(TAG, i)
  put_hash(X, L, TAG)

  static([Instructions])

Notation
********
  X ::= a(i) | S
  Y ::= y(i) | S
  S ::= s(i) | si(i) | sf(i)
  L ::= f/n | f/n+i | f/n+TAG | f/n+TAG+i | f/n+TAG+i+i
  TAG ::= var | int | flo | con | str | lis | top | sub | nil
  BinG ::= C | f(A1,..,An, C) 
  G ::= f(A1,..,An) 
  A ::= void | X
  C ::= cont | p(N)
  R ::= cont | econt | a(i) | arg(i) | ea(i)

*****************************************************************/

/*****************************************************************
  Declarations
*****************************************************************/
:- op(1170, xfx, (:-)).
:- op(1170, xfx, (-->)).
:- op(1170,  fx, (:-)).
:- op(1170,  fx, (?-)).
:- op( 500, yfx, (#)).

:- op(1150,  fx, (dynamic)).
:- op(1150,  fx, (meta_predicate)).
:- op(1150,  fx, (package)).  % Prolog Cafe specific
:- op(1150,  fx, (public)).
:- op(1150,  fx, (import)).   % Prolog Cafe specific
:- op(1150,  fx, (mode)).
:- op(1150,  fx, (multifile)).
:- op(1150,  fx, (block)).

:- dynamic internal_clause/2.
:- dynamic internal_predicates/2.
:- dynamic dynamic_predicates/2.
:- dynamic meta_predicates/3.
:- dynamic package_name/1.
:- dynamic public_predicates/2.
:- dynamic import_package/2.
:- dynamic internal_declarations/1.
:- dynamic file_name/1.
:- dynamic dummy_clause_counter/1.
:- dynamic pl2am_flag/1.
:- dynamic fail_flag/0.  % used for generating label(fail/0) or not

% :- module('com.googlecode.prolog_cafe.compiler.pl2am', [main/0,pl2am/1]).
package(_). 
:- package 'com.googlecode.prolog_cafe.compiler.pl2am'.

:- public main/0, pl2am/1.
/*****************************************************************
  Main
*****************************************************************/
main :- 
	read(X), 
	pl2am(X).

pl2am([PrologFile, AsmFile, Opts]) :-
	read_in_program(PrologFile, Opts),
	open(AsmFile, write, Out),
	compile_all_predicates(Out),
	close(Out).
pl2am(_).

/*****************************************************************
  Read in Program
*****************************************************************/
read_in_program(File, Opts) :-
	pl2am_preread(File, Opts),
	open(File, read, In),
	repeat,
	  read(In, X),
	  assert_clause(X),
	X == end_of_file,
	!,
	close(In),
	pl2am_postread.

%%% Pre-init
pl2am_preread(File, Opts) :-
	retractall(internal_clause(_,_)),
	retractall(internal_predicates(_,_)),
	retractall(dynamic_predicates(_,_)),
	retractall(meta_predicates(_,_,_)),
	retractall(package_name(_)),
	retractall(public_predicates(_,_)),
	retractall(import_package(_,_)),
	retractall(internal_declarations(_)),
	retractall(file_name(_)),
	retractall(dummy_clause_counter(_)),
	retractall(pl2am_flag(_)),
	retractall(fail_flag),
	assert(file_name(File)),
	assert(dummy_clause_counter(0)),
	assert_compile_opts(Opts),
	assert_default_decls.

assert_default_decls :- 
	builtin_meta_predicates(Pred, Arity, Mode), 
	assert(meta_predicates(Pred, Arity, Mode)),
	fail.
assert_default_decls.

assert_compile_opts([]) :- !.
assert_compile_opts([O|Os]) :- 
	assert_copts(O),
	assert_compile_opts(Os).

assert_copts(O) :- 
	clause(pl2am_flag(O), _),
	!.
assert_copts(O) :- 
	copt_expr(O),
	!,
	assert(pl2am_flag(O)).
assert_copts(O) :- 
	pl2am_error([O,is,an,invalid,option,for,pl2am]),
	fail.

copt_expr(ed).
copt_expr(ac).
copt_expr(ie).
copt_expr(rc).
copt_expr(rc(_,_)).
copt_expr(idx).
copt_expr(clo).

%%% Post-init
pl2am_postread :- 
	assert_import('com.googlecode.prolog_cafe.lang'),
	assert_import('com.googlecode.prolog_cafe.builtin'),
	assert_dummy_package,
	assert_dummy_public.

assert_dummy_package :- 
	clause(package_name(_), _),
	!.
assert_dummy_package :- 
	assert(package_name(user)).

assert_dummy_public :- 
	clause(public_predicates(_,_), _),
	!.
assert_dummy_public :- 
	assert(public_predicates(_,_)).

%%% Assert Clauses
assert_clause(end_of_file) :- !.
assert_clause((:- dynamic G)) :- !,
	conj_to_list(G, G1),
	assert_dynamic_predicates(G1).
assert_clause((:- module(M, PList))) :- !,
	assert_package(M),
	assert_public_predicates(PList).
assert_clause((:- meta_predicate G)) :- !,
	conj_to_list(G, G1),
	assert_meta_predicates(G1).
assert_clause((:- package G)) :- !, 
	assert_package(G).
assert_clause((:- public G)) :- !,
	conj_to_list(G, G1),
	assert_public_predicates(G1).
assert_clause((:- import G)) :- !,
	assert_import(G).
assert_clause((:- mode _G)) :- !,
	pl2am_message(['*** WARNING',mode,declaration,is,not,supported,yet]).
assert_clause((:- multifile _G)) :- !,
	pl2am_message(['*** WARNING',multifile,declaration,is,not,supported,yet]).
assert_clause((:- block _G)) :- !,
	pl2am_message(['*** WARNING',block,declaration,is,not,supported,yet]).
assert_clause((:- G)) :- !, 
	call(G),
	assert_declarations(G).
assert_clause(Clause) :-
	preprocess(Clause, Cl),
	assert_cls(Cl).

%%% Dynamic Declaration
assert_dynamic_predicates([]) :- !.
assert_dynamic_predicates([G|Gs]) :-
	assert_dynamic(G),
	assert_dynamic_predicates(Gs).

assert_dynamic(G) :-
	\+ clause(package_name('com.googlecode.prolog_cafe.builtin'), _),
	G = F/A,
	functor(Head, F, A),
	system_predicate(Head),
	!,
	pl2am_error([can,not,redefine,builtin,predicate,F/A]),
	fail.
assert_dynamic(G) :-
	G = F/A,
	clause(dynamic_predicates(F,A), _), !.
assert_dynamic(G) :-
	G = F/A,
	assert(dynamic_predicates(F,A)), !.
assert_dynamic(G) :- 
	pl2am_error([G,is,an,invalid,dynamic,declaration]),
	fail.

%%% Meta Predicates Declaration
assert_meta_predicates([]) :- !.
assert_meta_predicates([G|Gs]) :-
	assert_meta(G),
	assert_meta_predicates(Gs).

assert_meta(G) :-
	functor(G, F, A),
	clause(meta_predicates(F, A, _), _),
	!.
assert_meta(G) :-
	functor(G, F, A),
	G =.. [_|M],
	mode_expr(M),
	!,
	assert(meta_predicates(F, A, M)).
assert_meta(G) :-
	pl2am_error([G,is,an,invalid,meta_predicate,declaration]),
	fail.

%%% Package Declaration
assert_package(G) :- 
	clause(package_name(G1), _),
	G \== G1,
	!,
	pl2am_error([duplicate,package,declarations,:,G1,and,G]),
	fail.
assert_package(G) :- 
	atom(G), 
	!,
	assert(package_name(G)),
	retractall(import_package(G, _)).
assert_package(G) :- 
	pl2am_error([G,is,invalid,package,declaration]), 
	fail.

%%% Public Declaration
assert_public_predicates([]) :- !.
assert_public_predicates([G|Gs]) :-
	assert_public(G),
	assert_public_predicates(Gs).

assert_public(F/A) :- 
	predspec_expr(F/A),
	clause(public_predicates(F, A), _),
	!.
assert_public(F/A) :-
	predspec_expr(F/A),
	assert(public_predicates(F, A)).

%%% Import Declaration
assert_import(G) :- 
	atom(G), 
	!, 
	assert_impt(G, (*)).
assert_import(M:P) :- 
	atom(M),
	(predspec_expr(P) ; atom(P)),
	!, 
	assert_impt(M, P).
assert_import(G) :- 
	pl2am_error([G,is,invalid,import,declaration]), 
	fail.

assert_impt(M, _P) :-
	clause(package_name(M), _),
	!.
assert_impt(M, P) :-
	clause(import_package(M, P0), _),
	(P0 == (*) ; P0 == P),
	!.
assert_impt(M, P) :- 
	assert(import_package(M, P)).

%%% Assert Declaration (:- G)
assert_declarations(G) :- 
	clause(internal_declarations(G), _),
	!.
assert_declarations(G) :- 
	assert(internal_declarations(G)).

%%% Assert Cluase
assert_cls((Head :- Body)) :- !,
	assert_predicate(Head),
	assert(internal_clause(Head, Body)).
assert_cls(Head) :- !,
	assert_predicate(Head),
	assert(internal_clause(Head, true)).

assert_predicate(Head) :-
	\+ clause(package_name('com.googlecode.prolog_cafe.builtin'), _),
	system_predicate(Head),
	!,
	functor(Head, Functor, Arity),	
	pl2am_error([can,not,redefine,builtin,predicate,Functor/Arity]),
	fail.
assert_predicate(Head) :-
	functor(Head, Functor, Arity),
	clause(internal_predicates(Functor, Arity), _),
	!.
assert_predicate(Head) :-
	functor(Head, Functor, Arity),
	assert(internal_predicates(Functor, Arity)).

%%% Preprocess
preprocess(Cl0, Cl) :-
	clause(pl2am_flag(ed), _),
	!,
	expand_term(Cl0, Cl1),
	eliminate_disjunction(Cl1, Cl).
preprocess(Cl0, Cl) :-
	expand_term(Cl0, Cl).

eliminate_disjunction(Cl0, Cl) :- 
	eliminate_disj(Cl0, Cl, DummyCls),
	assert_dummy_clauses(DummyCls).

assert_dummy_clauses([]) :- !.
assert_dummy_clauses([C|Cs]) :- 
	assert_clause(C),
	assert_dummy_clauses(Cs).

/*****************************************************************
  Compile Prolog Program
*****************************************************************/
compile_all_predicates(Out) :- % output declarations (ex. op/3)
	clause(internal_declarations(G), _),
	writeq(Out, (:- G)), write(Out, '.'), nl(Out), 
	fail.
compile_all_predicates(_) :-   % treat dynamic declaration
	findall(Functor/Arity, dynamic_predicates(Functor, Arity), PredSpecs),
	assert_init_clauses(PredSpecs),
	fail.
compile_all_predicates(Out) :- % compile predicate
	clause(internal_predicates(Functor, Arity), _),
	compile_predicate(Functor, Arity, Instructions, []),
	write_asm(Out, Instructions), 
	nl(Out), 
	fail.
compile_all_predicates(Out):- nl(Out).

write_asm(_, []) :- !.
write_asm(Out, [Instruction|Instructions]) :- !,
	write_asm(Out, Instruction),
	write_asm(Out, Instructions).
write_asm(Out, begin_predicate(P, FA)) :- !,
	writeq(Out, begin_predicate(P, FA)), write(Out, '.'), nl(Out).
write_asm(Out, end_predicate(P, FA)) :- !,
	writeq(Out, end_predicate(P, FA)), write(Out, '.'), nl(Out).
write_asm(Out, comment(Comment0)) :- !,
	copy_term(Comment0, Comment),
	numbervars(Comment, 0, _),
        tab(Out, 8), writeq(Out, comment(Comment)), write(Out, '.'), nl(Out).
write_asm(Out, (Label: Instruction)) :- !,
	writeq(Out, Label), write(Out, ' :'), nl(Out),
	write_asm(Out, Instruction).
write_asm(Out, Instruction) :-
	tab(Out, 8), writeq(Out, Instruction), write(Out, '.'), nl(Out).

/****************************************************************
  Treat Dynamic Declaration
****************************************************************/
assert_init_clauses([]) :- !.
assert_init_clauses(PredSpecs) :-
	collect_init_cls(PredSpecs, Cls),
	assert_init_cls(Cls),
	!.

collect_init_cls([], []) :- !.
collect_init_cls([F/A|FAs], [Cls|Cls1]) :-
	clause(internal_predicates(F,A), _),
	!,
	functor(Head, F, A),
	findall(assertz((Head :- Body)), internal_clause(Head, Body), Cls),
	retractall(internal_predicates(F,A)),
	retractall(internal_clause(Head, _)),
	collect_init_cls(FAs, Cls1).
%collect_init_cls([FA|FAs], [hash_put(P,FA,[])|Cls]) :-
collect_init_cls([FA|FAs], ['$new_indexing_hash'(P,FA,_)|Cls]) :-
	clause(package_name(P), _),
	!,
	collect_init_cls(FAs, Cls).

assert_init_cls([]) :- !.
assert_init_cls(Cls) :- 
	list_to_conj(Cls, Body),
	assert_clause(('$init' :- Body)).

/****************************************************************
  Compile Predicate
****************************************************************/
compile_predicate(Functor, Arity) -->
	{functor(Head, Functor, Arity)},
	{findall((Head :- Body), internal_clause(Head, Body), Clauses)},
	{clause(package_name(P), _)},
	[begin_predicate(P, Functor/Arity)],
	generate_info(Functor, Arity),
	generate_import,
	compile_pred(Clauses, Functor/Arity),
	[end_predicate(P, Functor/Arity)].

%%% Program Code
compile_pred([], _) --> [], !.
compile_pred([Clause], FA) --> !,
	{check_modifier(FA, MF)}, % checks public or non-public
	[main(FA, MF): []],
	[PutGroundTerm],    % generates put instructions of ground terms
	[FA: []],
	[comment(Clause)],  
	[setB0],            % set B0 register for cut
	[DeclLocalVars],    % generates the declarations of local variables
	{FA = _/A},
	set_arguments(1, A, arg, a, set), % set arg(N) to a(N).
	{GTI0 = [1,[],[]]}, % GTI0 = [SN,SAlloc,PutGroundTerm]
	compile_clause(Clause, GTI0, GTI, LTI),
	{GTI = [_,_,PutGroundTerm0], pl2am_rev(PutGroundTerm0, PutGroundTerm)},
	{LTI = [XN,_,PN|_], generate_var_decl([1,1], [XN,PN], DeclLocalVars, [])}.
compile_pred(Clauses, FA) --> 
	{check_modifier(FA, MF)}, % checks public or non-public
	[main(FA,MF): []],
	[PutGroundTerm],    % generates ground terms
	[OPT1],
	[PutLabel],         % generates label declarations
	[NewHash],          % generates new_hash
	[PutHash],          % generates pub_hash
	%
	[FA: []],
	{FA = Functor/Arity},
	set_arguments(1, Arity, arg, ea, set), % set arg(N) to engine.areg(N)
	[set(cont, econt)], % set cont to engine.cont
	[OPT2],
	[OPT3],
	[setB0],            % set B0 register for cut
	generate_switch(Clauses, FA, GLI), % generates control and indexing instructions.
	{GTI0 = [1,[],[]]}, % GTI0 = [SN,SAlloc,PutGroundTerm]
	compile_pred2(Clauses, FA, 1, GTI0, GTI),
	%
	{GTI = [_,SAlloc,PutGroundTerm0], pl2am_rev(PutGroundTerm0, PutGroundTerm)},
	{GLI = [PutLabel, Hash0]},
	% replace the hash key with s(i), si(i), or sf(i)
	{replace_hash_keys(Hash0, SAlloc, NewHash, PutHash0)},
	{PutHash0 == [] -> PutHash = [] ; PutHash = static(PutHash0)},
	% generate code for the recursize call optimization
	{clause(pl2am_flag(rc(Functor,Arity)), _) -> 
              OPT1 = label(FA+top), OPT2 = goto(FA+top), OPT3 = FA+top: []
              ;
              OPT1 = [], OPT2 = [], OPT3 = []
	}.

compile_pred2([], _, _, GTI, GTI) --> !.
compile_pred2([Clause|Clauses], FA, N, GTI0, GTI) -->
	[FA+N: []],
	[comment(Clause)],  
	[DeclLocalVars],    % generates the declarations of local variables
	[decl_pred_vars([cont])],
	{FA = _/Arity},
	set_arguments(1, Arity, ea, a, set), % set engine.areg(N) to a(N).
	[set(econt, cont)], % set engine.cont to cont
	compile_clause(Clause, GTI0, GTI1, LTI),
	{N1 is N + 1},
	compile_pred2(Clauses, FA, N1, GTI1, GTI),
	{LTI = [XN,_,PN|_], generate_var_decl([1,1], [XN,PN], DeclLocalVars, [])}.

%%% Control and Indexing instructions
generate_switch(Clauses, FA, [Label, Hash]) --> 
	% generates try, retry, trust, switch_on_term, and switch_on_hash
	{generate_switch0(Clauses, FA, Instrs, [])},
	% generates sub-labels for BP
	generate_bp_label(Instrs, FA+sub, 1, Ls0, SWTs),
	% generates fail label (fail_flag may be asserted by generate_switch0/4)
	{(retract(fail_flag) -> Ls1 = [label(fail/0)|Ls0] ; Ls1 = Ls0)},
	% generates labels for clauses
	{length(Clauses, N)},
	{generate_cl_label(FA, 1, N, Ls2)},
	{pl2am_append(Ls1, Ls2, Label)},
	% generates new_hash and put_hash instructions for switch_on_hash
	{gen_hash(SWTs, Hash, [])}.

generate_switch0(Clauses, FA) --> 
	{get_indices(Clauses, FA, 1, Is)},
	generate_switch1(Is, FA).

%%% 1st. Indexing
generate_switch1(Is, FA) -->
	{FA = _/0},
	!,
	generate_tries(Is).
generate_switch1(Is, _) -->
	{all_variable_indices(Is)},
	!,
	generate_tries(Is).
generate_switch1(Is, FA) -->
	[switch_on_term(LV,LI,LF,LC,LS,LL)],
	generate_sw(Is, FA, var, LV, [], PIs0),
	generate_sw(Is, FA, int, LI, PIs0, PIs1),
	generate_sw(Is, FA, flo, LF, PIs1, PIs2),
	generate_sw(Is, FA, con, LC, PIs2, PIs3),
	generate_sw(Is, FA, str, LS, PIs3, PIs4),
	generate_sw(Is, FA, lis, LL, PIs4, _).

generate_sw(Is, FA, Tag, L, PIs0, PIs) -->
	{select_indices(Is, Tag, Is1)},
	generate_sw1(Is1, FA, Tag, L, PIs0, PIs).

%%% 2nd. Indexing
generate_sw1([], _, _, fail/0, PIs, PIs) --> !, {assert_fail}.
generate_sw1([I], _, _, L, PIs, PIs) --> !, {I = [L|_]}.
generate_sw1(Is, FA, Tag, L, PIs0, PIs) -->
	{no_switch_on_hash(Is, Tag)},
	!,
	generate_sw2(Is, FA, Tag, L, PIs0, PIs).
generate_sw1(Is, FA, Tag, FA+Tag, PIs0, PIs) -->
	generate_sw(Is, FA, nil, L, PIs0, PIs),
	{count_unique_hash(Is, Size, Keys)},
	[FA+Tag: switch_on_hash(Tag, Size, L, HT)], 
	{generate_hash_table(Keys, Is, LIs)},
	generate_hash_tries(LIs, FA+Tag, 0, HT).

no_switch_on_hash(Is, Tag) :- 
	clause(pl2am_flag(idx), _), 
	!,
	(Tag = var ; Tag = lis ; Tag = nil ; count_unique_hash(Is, C, _), C < 2).
no_switch_on_hash(_, _).

generate_sw2(Is, _, _, L, PIs, PIs) -->
	{pl2am_member((L,Is), PIs)},
	!.
generate_sw2(Is, FA, Tag, FA+Tag, PIs0, [(FA+Tag,Is)|PIs0]) -->
	[FA+Tag: []], 
	generate_tries(Is).

generate_hash_tries([], _, _, []) --> !.
generate_hash_tries([K:[]|LIs], L0, N, [K:fail/0|Ls]) --> !,
	{assert_fail},
	generate_hash_tries(LIs, L0, N, Ls).
generate_hash_tries([K:[I]|LIs], L0, N, [K:L|Ls]) --> !,
	{I = [L|_]},
	generate_hash_tries(LIs, L0, N, Ls).
generate_hash_tries([K:Is|LIs], L0, N, [K:L0+N|Ls]) -->
	[L0+N: []], 
	generate_tries(Is),
	{N1 is N + 1},
	generate_hash_tries(LIs, L0, N1, Ls).

generate_hash_table([], _, []) :- !.
generate_hash_table([K|Ks], Is0, [K:Is|LIs]) :-
	select_hash(Is0, K, Is),
	generate_hash_table(Ks, Is0, LIs).

select_hash([], _, []).
select_hash([I|Is0], K, [I|Is]) :-
	I = [_,_,Tag,Hash],
	(Tag = var ; K = Hash),
	!,
	select_hash(Is0, K, Is).
select_hash([_|Is0], K, Is) :-
	select_hash(Is0, K, Is).

%%% Choice Point (try, retry, trust)
generate_tries([I|Is]) -->
	{I = [L|_]},
	[try(L)],
	generate_tries1(Is).

generate_tries1([I]) --> !,
	{I = [L|_]},
	[trust(L)].
generate_tries1([I|Is]) -->
	{I = [L|_]},
	[retry(L)],
	generate_tries1(Is).

get_indices([], _, _, []).
get_indices([_|Clauses], FA, N, [[FA+N]|Is]) :-
	FA = _/0,
	!,
	N1 is N + 1,
	get_indices(Clauses, FA, N1, Is).
get_indices([Clause|Clauses], FA, N, [[FA+N,A1,Tag,Hash]|Is]) :-
	Clause = (Head :- _),
	arg(1, Head, A1),
	get_hash(A1, Tag, Hash),
	N1 is N + 1,
	get_indices(Clauses, FA, N1, Is).

get_hash(X, var, 0) :- var(X), !.
get_hash(X, int, X) :- integer(X), !.
get_hash(X, flo, X) :- float(X), !.
get_hash(X, con, X) :- atom(X), !.
get_hash(X, lis, '.'/2) :- X = [_|_], !.
get_hash(X, str, F/A) :- functor(X, F, A), !.

all_variable_indices([]).
all_variable_indices([[_,_,var,_]|Is]) :-
	all_variable_indices(Is).

count_unique_hash([], 0, []).
count_unique_hash([I|Is], C, K) :-
	count_unique_hash(Is, C0, K0),
	I = [_,_,Tag,Hash],
	((Tag = var ; pl2am_member([_,_,_,Hash], Is)) ->
	    C = C0, K = K0
	;
	    C is C0 + 1, K = [Hash|K0]
	).

select_indices([], _, []).
select_indices([I|Is0], Tag, [I|Is]) :-
	I = [_,_,T|_],
	(Tag = var ; Tag = T ; T = var),
	!,
	select_indices(Is0, Tag, Is).
select_indices([_|Is0], Tag, Is) :-
	select_indices(Is0, Tag, Is).

%%% Assert Fail Flag
assert_fail:- clause(fail_flag, _), !.
assert_fail:- assert(fail_flag).

%%% Generate Labels for Backtrack Point
generate_bp_label([], _, _, [], []) --> !.
generate_bp_label([X|Xs], CL, N, Ls, [X|Hs]) --> 
	{X = switch_on_hash(_,_,_,_)},
	!,
	[X],
	generate_bp_label(Xs, CL, N, Ls, Hs).
generate_bp_label([try(L)|Xs], CL, N, [label(CL+N)|Ls], Hs) --> !,
	[try(L, CL+N)],
	[CL+N: []],
	{N1 is N+1},
	generate_bp_label(Xs, CL, N1, Ls, Hs).
generate_bp_label([retry(L)|Xs], CL, N, [label(CL+N)|Ls], Hs) --> !,
	[retry(L, CL+N)],
	[CL+N: []],
	{N1 is N+1},
	generate_bp_label(Xs, CL, N1, Ls, Hs).
generate_bp_label([(L:X)|Xs], _, _, [label(L)|Ls], Hs) --> !,
	[L: []],
	generate_bp_label([X|Xs], L, 1, Ls, Hs).
generate_bp_label([X|Xs], CL, N, Ls, Hs) --> 
	[X],
	generate_bp_label(Xs, CL, N, Ls, Hs).

generate_cl_label(_, I, N, []) :- 
	I > N, 
	!.
generate_cl_label(FA, I, N, [label(FA+I)|Ls]) :- 
	I1 is I+1,
	generate_cl_label(FA, I1, N, Ls).

%%% Generate Hash instructions for switch_on_hash
gen_hash([]) --> !.
gen_hash([switch_on_hash(T,S,_,H)|Xs]) --> !,
	[new_hash(T,S)],
	gen_put_hash(H, T),
	gen_hash(Xs).

gen_put_hash([], _) --> !.
gen_put_hash([K:V|Xs], T) -->
	[put_hash(K, V, T)],
	gen_put_hash(Xs, T).

replace_hash_keys([], _, [], []) :- !.
replace_hash_keys([put_hash(K,L,H)|Xs], SA, NHs, [put_hash(X,L,H)|PHs]) :- !,
	replace_key(K, SA, X),
	replace_hash_keys(Xs, SA, NHs, PHs).
replace_hash_keys([X|Xs], SA, [X|NHs], PHs) :-
	replace_hash_keys(Xs, SA, NHs, PHs).

replace_key(K, Alloc, X) :-
	integer(K),
	allocated(Alloc, K:int, [X,yes]),
	!.
replace_key(K, Alloc, X) :-
	float(K),
	allocated(Alloc, K:flo, [X,yes]),
	!.
replace_key(K, Alloc, X) :-
	atom(K),
	allocated(Alloc, K:con, [X,yes]),
	!.
replace_key(K, Alloc, X) :-
	nonvar(K),
	K = F/A,
	atom(F),
	integer(A),
	allocated(Alloc, K:con, [X,yes]),
	!.
replace_key(K, _, _) :-
	pl2am_error([replacement,of,hash,key,K,failed]),
	fail.

%%% Import Declarations
generate_import --> 
	{findall((P,C), import_package(P, C), X)},
	gen_import(X).

gen_import([]) --> !.
gen_import([(P,'*')|Xs]) --> !, 
	[import_package(P)],
	gen_import(Xs).
gen_import([(P,C)|Xs]) --> 
	[import_package(P, C)],
	gen_import(Xs).

%%% Information
generate_info(Functor, Arity) --> 
	{clause(file_name(File), _)},
	[info([Functor/Arity, File])].

%%% Check the Modifier of Predicate F/A.
check_modifier('$init'/0, public) :- !.
check_modifier(F/A, public) :-
	clause(public_predicates(F, A), _),
	!.
check_modifier(_, non-public).

%%% generate a list of registers with given range.
range_reg(I, N, _, []) :- I > N, !.
range_reg(I, N, A, [R|Rs]) :- 
	I =< N, 
	I1 is I+1, 
	R =.. [A, I],
	range_reg(I1, N, A, Rs).

%%% generate set instructions
gen_set([], []) --> !.
gen_set([X|Xs], [Y|Ys]) --> [set(X, Y)], gen_set(Xs, Ys).

%%% generate deref instructions
gen_deref([], []) --> !.
gen_deref([X|Xs], [Y|Ys]) --> [deref(X, Y)], gen_deref(Xs, Ys).

%%% generate set and deref instructions
set_arguments(SN, EN, R1, R2, Flag) -->
	{range_reg(SN, EN, R1, L1)},
	{range_reg(SN, EN, R2, L2)},
	gen_set_arg(Flag, L1, L2).

gen_set_arg(set, L1, L2) --> gen_set(L1, L2).
gen_set_arg(deref, L1, L2) --> gen_deref(L1, L2).

%%% generate decl_var instructions
generate_var_decl([X0,P0], [XN,PN]) -->
	{X1 is XN-1, P1 is PN-1},
	{range_reg(X0, X1, a, XL)},
	{range_reg(P0, P1, p, PL)},
	gen_decl_term_vars(XL),
	gen_decl_pred_vars(PL).

gen_decl_term_vars([]) --> !.
gen_decl_term_vars(XL) --> [decl_term_vars(XL)].

gen_decl_pred_vars([]) --> !.
gen_decl_pred_vars(PL) --> [decl_pred_vars(PL)].

/****************************************************************
  Compile Clause
****************************************************************/
compile_clause((Head :- Body), GTI0, GTI, LTI) --> 
	{pretreat_body(Body, Goals0)},     % cut, rename, compile aith exp.
	{localize_meta(Goals0, Goals)},    % add package name for meta predicates
	{precompile(Head, Goals, Instrs)}, % generate get, put, put_clo, put_cont, inline
	[comment((Head :- Goals))],        % output precompiled clause
	compile_chunks(Instrs, GTI0, GTI, LTI),
	!.
compile_clause(Clause, _, _, _) -->
	{pl2am_error([compilation,of,Clause,failed])}, 
	{fail}.

%%%%%%%%%% Pretreat Body and Compile Arithmetic Expressions
pretreat_body(Body, Goals) :- 
	pretreat_body0(Body, Cut, Goals0, []),
	pretreat_cut(Cut, Goals0, Goals).

pretreat_cut(Cut, Gs, Gs) :- var(Cut), !.
pretreat_cut('$cut'(Level), ['$cut'(Level)|Gs], ['$neck_cut'|Gs]) :- !.
pretreat_cut('$cut'(Level), Gs, ['$get_level'(Level)|Gs]).

pretreat_body0(G, _) --> {var(G)}, !, [call(G)].
pretreat_body0(!, Cut) --> !, {Cut = '$cut'(Level)}, ['$cut'(Level)].
pretreat_body0(otherwise, _) --> !.
pretreat_body0(true, _)  --> !.
pretreat_body0(fail, _)  --> !, [fail].
pretreat_body0(false, _) --> !, [fail].
pretreat_body0(halt, _)  --> !, [halt].
pretreat_body0(abort, _) --> !, [abort].
pretreat_body0((G1,G2), Cut) --> !, pretreat_body0(G1, Cut), pretreat_body0(G2, Cut).
pretreat_body0(G, _) --> pretreat_builtin(G), !.
pretreat_body0(G, _) --> {functor(G, F, A), clause(dynamic_predicates(F, A), _)}, !, [call(G)].
pretreat_body0(G, _) --> [G].

%%% rename builtins
pretreat_builtin(X = Y)    --> !, ['$unify'(X, Y)].
pretreat_builtin(X \= Y)    --> !, ['$not_unifiable'(X, Y)].
pretreat_builtin(X == Y)   --> !, ['$equality_of_term'(X, Y)].
pretreat_builtin(X \== Y)  --> !, ['$inequality_of_term'(X, Y)].
pretreat_builtin(?=(X, Y)) --> !, ['$identical_or_cannot_unify'(X, Y)].
pretreat_builtin(X @< Y)   --> !, ['$before'(X, Y)].
pretreat_builtin(X @> Y)   --> !, ['$after'(X, Y)].
pretreat_builtin(X @=< Y)  --> !, ['$not_after'(X, Y)].
pretreat_builtin(X @>= Y)  --> !, ['$not_before'(X, Y)].
pretreat_builtin(compare(Op,X,Y)) --> {Op == (=)}, !, ['$equality_of_term'(X, Y)].
pretreat_builtin(compare(Op,X,Y)) --> {Op == (<)}, !, ['$before'(X, Y)].
pretreat_builtin(compare(Op,X,Y)) --> {Op == (>)}, !, ['$after'(X, Y)].
pretreat_builtin(X =.. Y)  --> !, ['$univ'(X, Y)].
pretreat_builtin(X =:= Y)  --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$arith_equal'(U, V)].
pretreat_builtin(X =\= Y)  --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$arith_not_equal'(U, V)].
pretreat_builtin(X > Y)    --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$greater_than'(U, V)].
pretreat_builtin(X >= Y)   --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$greater_or_equal'(U, V)].
pretreat_builtin(X < Y)    --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$less_than'(U, V)].
pretreat_builtin(X =< Y)   --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$less_or_equal'(U, V)].
pretreat_builtin(Z is X)   --> !, pretreat_is0(Z, X).

pretreat_is(Z, X) --> {var(X)}, !, {X = Z}.
pretreat_is(Z, X) --> pretreat_is0(Z, X).

pretreat_is0(Z, X) --> {clause(pl2am_flag(ac), _)}, !, precompile_is(X, Z).
pretreat_is0(Z, X) --> [is(Z, X)].

%%% compile aithmetic expressions
precompile_is(X, A) --> {var(X)}, !, [is(A, X)].
precompile_is(X, A) --> {number(X)}, !, {X = A}.
precompile_is(X, A) --> {builtin_arith_constant(X)}, !, {X = A}.
precompile_is(+(X), A) --> !, precomp_is(X, A).
precompile_is(-(X), A) --> !, precompile_is(-1*X, A).
precompile_is(X+Y,  A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$plus'(U, V, A)].
precompile_is(X-Y,  A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$minus'(U, V, A)].
precompile_is(X*Y,  A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$multi'(U, V, A)].
precompile_is(X/Y,  A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$float_quotient'(U, V, A)].
precompile_is(X//Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$int_quotient'(U, V, A)].
precompile_is(X mod Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$mod'(U, V, A)].
precompile_is(X rem Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$mod'(U, V, A)].
precompile_is(X/\Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$bitwise_conj'(U, V, A)].
precompile_is(X\/Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$bitwise_disj'(U, V, A)].
precompile_is(X#Y,  A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$bitwise_exclusive_or'(U, V, A)].
precompile_is(\(X), A) --> !, precomp_is(X, U), ['$bitwise_neg'(U, A)].
precompile_is(X<<Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$shift_left'(U, V, A)].
precompile_is(X>>Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$shift_right'(U, V, A)].
precompile_is([X],  A) --> !, precomp_is(X, A).
precompile_is(abs(X),     A) --> !, precomp_is(X, U), ['$abs'(U, A)].
precompile_is(min(X,Y),   A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$min'(U, V, A)].
precompile_is(max(X,Y),   A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$max'(U, V, A)].
precompile_is(round(X),   A) --> !, precomp_is(X, U), ['$round'(U, A)].
precompile_is(floor(X),   A) --> !, precomp_is(X, U), ['$floor'(U, A)].
precompile_is(ceiling(X),    A) --> !, precomp_is(X, U), ['$ceil'(U, A)].
precompile_is(sin(X),     A) --> !, precomp_is(X, U), ['$sin'(U, A)].
precompile_is(cos(X),     A) --> !, precomp_is(X, U), ['$cos'(U, A)].
precompile_is(tan(X),     A) --> !, precomp_is(X, U), ['$tan'(U, A)].
precompile_is(asin(X),    A) --> !, precomp_is(X, U), ['$asin'(U, A)].
precompile_is(acos(X),    A) --> !, precomp_is(X, U), ['$acos'(U, A)].
precompile_is(atan(X),    A) --> !, precomp_is(X, U), ['$atan'(U, A)].
precompile_is(sqrt(X),    A) --> !, precomp_is(X, U), ['$sqrt'(U, A)].
precompile_is(log(X),     A) --> !, precomp_is(X, U), ['$log'(U, A)].
precompile_is(exp(X),     A) --> !, precomp_is(X, U), ['$exp'(U, A)].
precompile_is(X**Y,   A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$pow'(U, V, A)].
precompile_is(degrees(X), A) --> !, precomp_is(X, U), ['$degrees'(U, A)].
precompile_is(radians(X), A) --> !, precomp_is(X, U), ['$radians'(U, A)].
precompile_is(rint(X),    A) --> !, precomp_is(X, U), ['$rint'(U, A)].
precompile_is(float(X),   A) --> !, precomp_is(X, U), ['$float'(U, A)].
precompile_is(float_integer_part(X),    A) --> !, precomp_is(X, U), ['$float_integer_part'(U, A)].
precompile_is(float_fractional_part(X), A) --> !, precomp_is(X, U), ['$float_fractional_part'(U, A)].
precompile_is(truncate(X),A) --> !, precomp_is(X, U), ['$truncate'(U, A)].
precompile_is(sign(X),    A) --> !, precomp_is(X, U), ['$sign'(U, A)].
precompile_is(X, _) -->
	{pl2am_error([unknown,arithemetic,expression,X])},
	{fail}.

precomp_is(X, A) --> {var(X)}, {var(A)}, !, {X = A}.
precomp_is(X, A) --> precompile_is(X, A).

%%%%%%%%%% Add Pacakge (module) name to meta predicates
localize_meta(G0, G) :-
	clause(package_name(P), _),
	localize_meta(G0, P, G),
	!.

localize_meta([], _, []) :- !.
localize_meta([G|Gs], P, [G1|Gs1]) :-
	localize_meta_goal(G, P, X),
	(X = P:Y -> G1 = Y ; G1 = X),
	localize_meta(Gs, P, Gs1).

localize_meta_goal(G, P, G1) :- var(G), !,
	localize_meta_goal(call(G), P, G1).
localize_meta_goal(P:G, _, G1) :- !,
	localize_meta_goal(G, P, G1).
localize_meta_goal((X,Y), P, (X1,Y1)) :- !,
	localize_meta_goal(X, P, X1),
	localize_meta_goal(Y, P, Y1).
localize_meta_goal((X->Y), P, (X1->Y1)) :- !,
	localize_meta_goal(X, P, X1),
	localize_meta_goal(Y, P, Y1).
localize_meta_goal((X;Y), P, (X1;Y1)) :- !,
	localize_meta_goal(X, P, X1),
	localize_meta_goal(Y, P, Y1).	
localize_meta_goal(G, P, G1) :-
	functor(G, F, A),
	(clause(meta_predicates(F, A, M), _) ; builtin_local_predicates(F, A, M)),
	!,
	G  =.. [F|As],
	localize_meta_args(M, As, P, As1),
	G1 =.. [F|As1].
localize_meta_goal(G, P, call(P:G)) :- var(P), !.
localize_meta_goal(G, _, G) :- system_predicate(G), !.
localize_meta_goal(G, P, P:G).

localize_meta_args([], [], _, []) :- !.
localize_meta_args([:|Ms], [A|As], P, [P:A|As1]) :-
	(var(A) ; A \= _:_),
	!,
	localize_meta_args(Ms, As, P, As1).
localize_meta_args([_|Ms], [A|As], P, [A|As1]) :-
	localize_meta_args(Ms, As, P, As1).

%%%%%%%%%% Precompile Clause and Optimize Recursive Call
precompile(Head, Goals, Instrs) :-
	precompile_head(Head, Instrs0, Bs),
	precompile_body(Goals, Bs, []),
	optimize_recursive_call(Head, Instrs0, Instrs).

%%% Precompile head (generates get instructions)
precompile_head(Head) -->
	{Head =.. [_|Args]},
	precomp_head(Args, 1).

precomp_head([], _) --> !.
precomp_head([A|As], I) -->
	[get(A, a(I))],
	{I1 is I + 1},
	precomp_head(As, I1).

%%% Precompile body
%%% (generates put, put_clo, put_cont, and inline instructions)
precompile_body(Goals) -->
	{clause(pl2am_flag(ie), _)},
	!,
	{pickup_inline_goals(Goals, IGs, Gs)},
	precomp_inline(IGs, Gs).
precompile_body(Goals) -->
	precomp_body(Goals).

precomp_body([]) --> !, [execute(cont)].
precomp_body([M:G|Cont]) --> !, 
	binarize_body(G, Cont, G1), 
	[execute(M:G1)].
precomp_body([G|Cont]) -->
	binarize_body(G, Cont, G1), 
	[execute(G1)].

/*---------------------------------------------------------------
 Binarization technique was developed by P.Tarau and M.Boyer,
 please see:
   * "Elementary Logic Programs"
     P.Tarau and M.Boyer
     Programming Language Implementation and Logic Programming,
     pp.159--173, LNCS 456, Springer Verlag, 1990
----------------------------------------------------------------*/
binarize_body(G, Cont, G1) -->
	{G  =.. [F|Args]},
	{functor(G, F, A)},
	precomp_call(Args, Us, F, A),
	%precomp_call(Args, Us), % for no closure
	precomp_cont(Cont, V),
	{pl2am_append(Us, [V], Ws)},
	{G1 =.. [F|Ws]}.

precomp_call([], []) --> !.
precomp_call([A|As], [U|Us]) -->
	[put(A, U)],
	precomp_call(As, Us).

precomp_cont([], cont) --> !.
precomp_cont([M:G|Cont], V) --> !,
	binarize_body(G, Cont, G1),
	[put_cont(M:G1, V)].
precomp_cont([G|Cont], V) -->
	binarize_body(G, Cont, G1),
	[put_cont(G1, V)].

precomp_inline([], Gs1) --> !, precomp_body(Gs1).
precomp_inline([fail|_], _) --> !, [inline(fail)].
precomp_inline([G|Gs], Gs1) --> 
	{G  =.. [F|Args]},
	{functor(G, F, A)},
	precomp_call(Args, Us, F, A),
	%precomp_call(Args, Us),
	{G1 =.. [F|Us]},
	[inline(G1)],
	precomp_inline(Gs, Gs1).

pickup_inline_goals([], [], []) :- !.
pickup_inline_goals([G|Gs], [G|IGs], BGs) :-
	builtin_inline_predicates(G),
	!,
	pickup_inline_goals(Gs, IGs, BGs).
pickup_inline_goals(Gs, [], Gs).

%%% Generate Closure
precomp_call(As, Us, Functor, Arity) --> 
	{clause(pl2am_flag(clo), _)},
	{clause(meta_predicates(Functor, Arity, Mode), _)},
	!,
	{clause(package_name(P), _)},
	precomp_closure(Mode, As, P, Us).
precomp_call(As, Us, _, _) --> precomp_call(As, Us).

precomp_closure([], [], _, []) --> !.
precomp_closure([:|Ms], [A|As], P, [U|Us]) -->
	{get_closure(A, P, C)},
	!,
	[put_clo(C, U)],
	precomp_closure(Ms, As, P, Us).
precomp_closure([_|Ms], [A|As], P, [U|Us]) -->
	[put(A, U)],
	precomp_closure(Ms, As, P, Us).

get_closure(G, _, _) :- var(G), !, fail.
get_closure(_, P, _) :- var(P), !, fail.
get_closure(P:G, _, Clo) :- !, get_closure(G, P, Clo).
get_closure(G, P, P:G) :-  % ???
	atom(P), 
	callable(G),
	functor(G, F, A),
	\+ clause(dynamic_predicates(F,A), _), 
	!.

%%% Optimize Recursive Call
optimize_recursive_call(Head, Instrs0, Instrs) :- 
	clause(pl2am_flag(rc), _),
	!,
	optimize_rc(Instrs0, Head, Instrs, []).
optimize_recursive_call(_, Instrs, Instrs).

optimize_rc([], _) --> !.
optimize_rc([execute(Goal)|Xs], Head) -->
	{functor(Head, F, A)},
	{functor(Goal, F, A1)},
	{A+1 =:= A1},
	!,
	{assert_copts(rc(F, A))},
	{Goal =.. [F|Args]},
	{range_reg(1, A, ea, Rs0)},
	{pl2am_append(Rs0, [econt], Rs)},
	gen_set(Args, Rs),
	[goto(F/A+top)],
	optimize_rc(Xs, Head).
optimize_rc([X|Xs], Head) -->
	[X],
	optimize_rc(Xs, Head).

%%%%%%%%%% Compile Clause
compile_chunks(Chunk, GTI0, GTI, LTI) -->
	{alloc_voids(Chunk, [], Alloc)},  % check void variables
        compile_chunk(Chunk, Alloc, GTI0, GTI, LTI).

compile_chunk([], _, GTI, GTI, []) --> !.
compile_chunk(Chunk, Alloc, GTI0, GTI, LTI) -->
	{free_x_reg(Chunk, 1, XN), YN = 1, PN = 1}, 
	{LTI0 = [XN, YN, PN, Alloc]},
	comp_chunk(Chunk, LTI0, LTI, GTI0, GTI).

comp_chunk([], LTI, LTI, GTI, GTI) --> !.
comp_chunk([(L:[])|Cs], LTI0, LTI, GTI0, GTI) --> !,
	[L:[]],
	comp_chunk(Cs, LTI0, LTI, GTI0, GTI).
comp_chunk([(L:C)|Cs], LTI0, LTI, GTI0, GTI) --> !,
	[L:[]],
	comp_chunk([C|Cs], LTI0, LTI, GTI0, GTI).
comp_chunk([C|Cs], LTI0, LTI, GTI0, GTI) --> !,
	comp_instr(C, LTI0, LTI1, GTI0, GTI1),
	comp_chunk(Cs, LTI1, LTI, GTI1, GTI).

%%% finds an available number A-register
free_x_reg([], XN, XN).
free_x_reg([get(_,V)|Cs], XN0, XN) :- nonvar(V), V = a(N), !,
	XN1 is max(N+1, XN0),
	free_x_reg(Cs, XN1, XN).
free_x_reg([put(_,V)|Cs], XN0, XN) :- nonvar(V), V = a(N), !,
	XN1 is max(N+1, XN0),
	free_x_reg(Cs, XN1, XN).
free_x_reg([_|Cs], XN0, XN) :-
	free_x_reg(Cs, XN0, XN).

%%% finds void variables and allocates them in Alloc.
alloc_voids(Chunks, Alloc0, Alloc) :-
	variables(Chunks, Vars),
	alloc_voids1(Vars, Chunks, Alloc0, Alloc).

alloc_voids1([], _, Alloc, Alloc).
alloc_voids1([V|Vars], Chunks, Alloc0, Alloc) :-
	count_variable(V, Chunks, 1),
	!,
	Alloc1 = [[V,void,_Seen]|Alloc0],
	alloc_voids1(Vars, Chunks, Alloc1, Alloc).
alloc_voids1([_|Vars], Chunks, Alloc0, Alloc) :-
	alloc_voids1(Vars, Chunks, Alloc0, Alloc).

%%%%%%%%%% Compile Precompiled Instructions: get, put, put_clo, and put_cont
/*
  comp_instr(+Instr, +LTI0, ?LTI, +GTI0, ?GTI)
  Instr    : Intermediate instruction
  LTI      : [XN, YN, PN, Alloc]
   XN      : The register a(XN) is available for "Term".
   YN      : The register y(YN) is available for "Term[]".
   PN      : The register p(PN) is available for "Predicate".
   Alloc   : [[VarTerm, Register, Seen],...]
  GTI      : [SN, SAlloc, SInstrs]
   SN      : The registers s(SN), si(SN), or sf(SN) are available for static "Term".
   SAlloc  : [[NonVarTerm:Type, Register, Seen],...]
   SInstrs : list of instructions for static terms.
  Seen     : Unbound variable | yes | void
  Type     : int | flo | con | str | lis | arr
*/
comp_instr(get(X, A), LTI0, LTI, GTI0, GTI) --> !, 
	gen_get(X, A, LTI0, LTI, GTI0, GTI).
comp_instr(put(X, V), LTI0, LTI, GTI0, GTI) --> !, 
	gen_put(X, V, LTI0, LTI, GTI0, GTI).
comp_instr(put_clo(X, V), LTI0, LTI, GTI0, GTI) --> !, 
	gen_put_clo(X, V, LTI0, LTI, GTI0, GTI).
comp_instr(put_cont(X, V), LTI0, LTI, GTI0, GTI) --> !, 
	gen_put_cont(X, V, LTI0, LTI, GTI0, GTI).
comp_instr(Instr, LTI, LTI, GTI, GTI) --> 
	[Instr].

%%%%%%%%%% put instructions
gen_put(_, A, _, _, _, _) --> {nonvar(A)}, !,
	{pl2am_error([A,should,be,an,unbound,variable])},
	{fail}.
gen_put(X, A, LTI0, LTI, GTI, GTI) --> {var(X)}, !,
	{assign_reg(X, R, Seen, LTI0, LTI)},
	gen_put_var(R, Seen, A).
gen_put(X, A, LTI, LTI, GTI0, GTI) --> {integer(X)}, !,
	{assign_sreg(X:int, R, Seen, GTI0, GTI1)},
	gen_put_int(X, R, Seen, A, GTI1, GTI).
gen_put(X, A, LTI, LTI, GTI0, GTI) --> {float(X)}, !,
	{assign_sreg(X:flo, R, Seen, GTI0, GTI1)},
	gen_put_float(X, R, Seen, A, GTI1, GTI).
gen_put(X, A, LTI, LTI, GTI0, GTI) --> {atom(X)}, !,
	{assign_sreg(X:con, R, Seen, GTI0, GTI1)},
	gen_put_con(X, R, Seen, A, GTI1, GTI).
gen_put(X, A, LTI0, LTI, GTI0, GTI) --> 
	{ground(X), X = [X1|X2]}, 
	!,
	gen_put_args([X1,X2], [R1,R2], LTI0, LTI, GTI0, GTI1),
	{assign_sreg(X:lis, R, Seen, GTI1, GTI2)},
	gen_put_list([R1,R2], R, Seen, A, GTI2, GTI).
gen_put(X, A, LTI0, LTI, GTI0, GTI) --> 
	{ground(X), X =..[_|Args], functor(X,F,N)},
	!,
	{assign_sreg(F/N:con, R0, Seen0, GTI0, GTI1)},
	gen_put_con(F/N, R0, Seen0, _, GTI1, GTI2),
	gen_put_args(Args, Regs, LTI0, LTI, GTI2, GTI3),
	{assign_sreg(Args:arr, R1, Seen1, GTI3, GTI4)},
	gen_put_str_args(Regs, R1, Seen1, _, GTI4, GTI5),
	{assign_sreg(X:str, R, Seen, GTI5, GTI6)},
	gen_put_str([R0,R1], R, Seen, A, GTI6, GTI).
gen_put(X, A, LTI0, LTI, GTI0, GTI) --> 
	{X = [X1|X2]}, 
	!,
	gen_put_args([X1,X2], [R1,R2], LTI0, LTI1, GTI0, GTI),
	{assign_reg(_, R, Seen, LTI1, LTI)},
	{Seen = yes, R = A},
	[put_list(R1, R2, R)].
gen_put(X, A, LTI0, LTI, GTI0, GTI) -->
	{X =..[_|Args], functor(X,F,N)},
	!,
	{assign_sreg(F/N:con, R0, Seen0, GTI0, GTI1)},
	gen_put_con(F/N, R0, Seen0, _, GTI1, GTI2),
	gen_put_args(Args, Regs, LTI0, LTI1, GTI2, GTI),
	{inc_YN(R1, LTI1, LTI2)},
	{assign_reg(_, R, Seen, LTI2, LTI)},
	{Seen = yes, R = A},
	[put_str_args(Regs, R1)],
	[put_str(R0, R1, R)].

gen_put_var(void, _, A) --> !, {A = void}. % void is a special constant.
gen_put_var(R, Seen, A) --> {var(Seen)}, !, 
	{Seen = yes, R = A}, 
	[put_var(R)].
gen_put_var(R, _, A) --> {R = A}.

gen_put_int(X, R, Seen, A, GTI0, GTI)  --> {var(Seen)}, !, 
	{Seen = yes, R = A},
	{add_instr(put_int(X, R), GTI0, GTI)}.
gen_put_int(_, R, _, A, GTI, GTI)  --> {R = A}.

gen_put_float(X, R, Seen, A, GTI0, GTI)  --> {var(Seen)}, !, 
	{Seen = yes, R = A},
	{add_instr(put_float(X, R), GTI0, GTI)}.
gen_put_float(_, R, _, A, GTI, GTI)  --> {R = A}.

gen_put_con(X, R, Seen, A, GTI0, GTI)  --> {var(Seen)}, !, 
	{Seen = yes, R = A},
	{add_instr(put_con(X, R), GTI0, GTI)}.
gen_put_con(_, R, _, A, GTI, GTI)  --> {R = A}.

gen_put_list([R1,R2], R, Seen, A, GTI0, GTI) --> {var(Seen)}, !, 
	{Seen = yes, R = A},
	{add_instr(put_list(R1, R2, R), GTI0, GTI)}.
gen_put_list(_, R, _, A, GTI, GTI) --> {R = A}.

gen_put_str_args(Regs, R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
	{Seen = yes, R = A},
	{add_instr(put_str_args(Regs, R), GTI0, GTI)}.
gen_put_str_args(_, R, _, A, GTI, GTI) --> {R = A}.

gen_put_str([R0,R1], R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
	{Seen = yes, R = A},
	{add_instr(put_str(R0, R1, R), GTI0, GTI)}.
gen_put_str(_, R, _, A, GTI, GTI) --> {R = A}.

gen_put_args([], [], LTI, LTI, GTI, GTI) --> !.
gen_put_args([X|Xs], [R|Rs], LTI0, LTI, GTI0, GTI) -->
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	gen_put_args(Xs, Rs, LTI1, LTI, GTI1, GTI).

gen_put_clo(P:X, A, LTI0, LTI, GTI0, GTI) --> 
	{X =..[F|Args]},
	!,
	gen_put_args(Args, Regs, LTI0, LTI1, GTI0, GTI),
	{assign_reg(_, R, Seen, LTI1, LTI)},
	{Seen = yes, R = A},
	{X1 =..[F|Regs]},
	{(clause(package_name(P), _) -> CLO = X1 ; CLO = P:X1)},
	[put_clo(CLO, R)].

%%%%%%%%%% get instructions
gen_get(X, A, LTI0, LTI, GTI0, GTI) --> 
	gen_get([A=X], LTI0, LTI, GTI0, GTI).

gen_get([], LTI, LTI, GTI, GTI) --> !.
gen_get([A=X|_], LTI, LTI, GTI, GTI) --> 
	{var(A)}, 
	!,
	{pl2am_error([A,must,not,be,a,variable,in,get(X,A)])},
	{fail}.
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{var(X)},
	{assign_reg(X, R, Seen, LTI0, LTI1)},
	{nonvar(Seen)},
	!,
	gen_get_var(R, Seen, A),
	gen_get(Instrs, LTI1, LTI, GTI0, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{var(X)}, 
	!,
	{add_alloc([X,A,yes], LTI0, LTI1)},
	gen_get(Instrs, LTI1, LTI, GTI0, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{integer(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[get_int(X, R, A)],
	gen_get(Instrs, LTI1, LTI, GTI1, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{float(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[get_float(X, R, A)],
	gen_get(Instrs, LTI1, LTI, GTI1, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{atom(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[get_con(X, R, A)],
	gen_get(Instrs, LTI1, LTI, GTI1, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{ground(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[get_ground(X, R, A)],
	gen_get(Instrs, LTI1, LTI, GTI1, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{X = [X1|X2]}, 
	!,
	[get_list(A)],
	gen_unify([X1,X2], Instrs1, LTI0, LTI1, GTI0, GTI1),
	gen_get(Instrs1, LTI1, LTI2, GTI1, GTI2),
	gen_get(Instrs, LTI2, LTI, GTI2, GTI).
gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{X =.. [F|Args], functor(X, F, N)},
	{assign_sreg(F/N:con, R, Seen, GTI0, GTI1)},
	gen_put_con(F/N, R, Seen, _, GTI1, GTI2),
	[get_str(F/N, R, A)],
	gen_unify(Args, Instrs1, LTI0, LTI1, GTI2, GTI3),
	gen_get(Instrs1, LTI1, LTI2, GTI3, GTI4),
	gen_get(Instrs, LTI2, LTI, GTI4, GTI).

gen_get_var(void, _, _) --> !.
gen_get_var(R, _, A) --> [get_val(R, A)].

%%%%%%%%%% unify instructions
gen_unify([], [], LTI, LTI, GTI, GTI) --> !.
gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) --> 
	{var(X)}, 
	!,
	{assign_reg(X, R, Seen, LTI0, LTI1)},
	gen_unify_var(R, Seen),
	gen_unify(Xs, Instrs, LTI1, LTI, GTI0, GTI).
gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) --> 
	{integer(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[unify_int(X, R)],
	gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) --> 
	{float(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[unify_float(X, R)],
	gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) --> 
	{atom(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[unify_con(X, R)],
	gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) --> 
	{ground(X)}, 
	!,
	gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
	[unify_ground(X, R)],
	gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
gen_unify([X|Xs], [R=X|Instrs], LTI0, LTI, GTI0, GTI) --> 
	{assign_reg(_, R, Seen, LTI0, LTI1)},
	gen_unify_var(R, Seen),
	gen_unify(Xs, Instrs, LTI1, LTI, GTI0, GTI).

%%% unify_void, unify_variable, unify_value
gen_unify_var(void, _) --> !, [unify_void(1)].
gen_unify_var(R, Seen) --> {var(Seen)}, !,
	{Seen = yes}, 
	[unify_var(R)].
gen_unify_var(R, _) --> [unify_val(R)].

%%%%%%%%%% generate continuation goal
gen_put_cont(X, R, LTI0, LTI, GTI, GTI) -->
	{inc_PN(R, LTI0, LTI)},
	[put_cont(X, R)].

%%% A register
assign_reg(X, Reg, Seen, LTI0, LTI) :- nonvar(X), !,
	pl2am_error([X,must,be,unbound,variable,in,assign_reg(X,Reg,Seen,LTI0,LTI)]),
	fail.
assign_reg(X, Reg, Seen, [XN,YN,PN,Alloc], [XN,YN,PN,Alloc]) :-
	allocated(Alloc, X, [Reg,Seen]),
	!.
assign_reg(X, Reg, Seen, [XN,YN,PN,Alloc], [XN1,YN,PN,Alloc1]) :-
	Reg = a(XN),
	XN1 is XN + 1,
	Alloc1 = [[X,Reg,Seen]|Alloc].

allocated([[V|X]|_], V0, X) :- V == V0, !.
allocated([_|Alloc], V0, X) :- allocated(Alloc, V0, X).

%%% S register
assign_sreg(X, Reg, Seen, GTI0, GTI) :- \+ ground(X), !,
	pl2am_error([X,must,be,ground,term,in,assign_sreg(X,Reg,Seen,GTI0,GTI)]),
	fail.
assign_sreg(X, Reg, Seen, [SN,SAlloc,SInstrs], [SN,SAlloc,SInstrs]) :-
	allocated(SAlloc, X, [Reg,Seen]),
	!.
assign_sreg(X:T, Reg, Seen, [SN,SAlloc,SInstrs], [SN1,SAlloc1,SInstrs]) :-
	assign_sreg0(T, SN, Reg),
	SN1 is SN+1,
	SAlloc1 = [[X:T,Reg,Seen]|SAlloc].

assign_sreg0(int, SN, si(SN)) :- !.
assign_sreg0(flo, SN, sf(SN)) :- !.
assign_sreg0(_,   SN,  s(SN)) :- !.
%assign_sreg0(con, SN, sc(SN)) :- !.
%assign_sreg0(str, SN, ss(SN)) :- !.
%assign_sreg0(lis, SN, sl(SN)) :- !.
%assign_sreg0(arr, SN, sa(SN)) :- !.

%%% incriment YN
inc_YN(y(YN), [XN,YN|Zs], [XN,YN1|Zs]) :- YN1 is YN+1.

%%% incriment PN
inc_PN(p(PN), [XN,YN,PN|Zs], [XN,YN,PN1|Zs]) :- PN1 is PN+1.

%%% add an instruction to GTI
add_instr(Instr, [SN,SAlloc,SInstrs0], [SN,SAlloc,[Instr|SInstrs0]]).

%%% add an allocation to LTI
add_alloc(E, [XN,YN,PN,Alloc0], [XN,YN,PN,[E|Alloc0]]).

/*****************************************************************
  Built-in Predicates and Constants
*****************************************************************/
builtin_meta_predicates((^), 2, [?,:]).
builtin_meta_predicates(call, 1, [:]).
builtin_meta_predicates(once, 1, [:]).
builtin_meta_predicates((\+), 1, [:]).
builtin_meta_predicates(findall, 3, [?,:,?]).
builtin_meta_predicates(bagof, 3, [?,:,?]).
builtin_meta_predicates(setof, 3, [?,:,?]).
builtin_meta_predicates(on_exception, 3, [?,:,:]).
builtin_meta_predicates(catch, 3, [:,?,:]).
builtin_meta_predicates(synchronized, 2, [?,:]).
builtin_meta_predicates(freeze, 2, [?,:]).

builtin_local_predicates(assert, 1, [:]).
builtin_local_predicates(asserta, 1, [:]).
builtin_local_predicates(assertz, 1, [:]).
builtin_local_predicates(retract, 1, [:]).
builtin_local_predicates(retractall, 1, [:]).
builtin_local_predicates(clause, 2, [:,?]).
builtin_local_predicates(abolish, 1, [:]).

% Control constructs
builtin_inline_predicates(fail).
builtin_inline_predicates('$get_level'(_)).
builtin_inline_predicates('$neck_cut').
builtin_inline_predicates('$cut'(_)).
% Term unification
builtin_inline_predicates('$unify'(_,_)).
builtin_inline_predicates('$not_unifiable'(_,_)).
% Type testing
builtin_inline_predicates(var(_)).
builtin_inline_predicates(atom(_)).
builtin_inline_predicates(integer(_)).
builtin_inline_predicates(float(_)).
builtin_inline_predicates(atomic(_)).
builtin_inline_predicates(nonvar(_)).
builtin_inline_predicates(number(_)).
builtin_inline_predicates(java(_)).
builtin_inline_predicates(java(_,_)).
builtin_inline_predicates(closure(_)).
builtin_inline_predicates(ground(_)).
% Term comparison
builtin_inline_predicates('$equality_of_term'(_,_)).
builtin_inline_predicates('$inequality_of_term'(_,_)).
builtin_inline_predicates('$after'(_,_)).
builtin_inline_predicates('$before'(_,_)).
builtin_inline_predicates('$not_after'(_,_)).
builtin_inline_predicates('$not_before'(_,_)).
builtin_inline_predicates('$identical_or_cannot_unify'(_,_)).
% Term creation and decomposition
builtin_inline_predicates(copy_term(_,_)).
% Arithmetic evaluation
builtin_inline_predicates(is(_,_)).
builtin_inline_predicates('$abs'(_,_)).
builtin_inline_predicates('$asin'(_,_)).
builtin_inline_predicates('$acos'(_,_)).
builtin_inline_predicates('$atan'(_,_)).
builtin_inline_predicates('$bitwise_conj'(_,_,_)).
builtin_inline_predicates('$bitwise_disj'(_,_,_)).
builtin_inline_predicates('$bitwise_exclusive_or'(_,_,_)).
builtin_inline_predicates('$bitwise_neg'(_,_)).
builtin_inline_predicates('$ceil'(_,_)).
builtin_inline_predicates('$cos'(_,_)).
builtin_inline_predicates('$degrees'(_,_)).
builtin_inline_predicates('$exp'(_,_)).
builtin_inline_predicates('$float_quotient'(_,_,_)).
builtin_inline_predicates('$floor'(_,_)).
builtin_inline_predicates('$int_quotient'(_,_,_)).
builtin_inline_predicates('$log'(_,_)).
builtin_inline_predicates('$max'(_,_,_)).
builtin_inline_predicates('$min'(_,_,_)).
builtin_inline_predicates('$minus'(_,_,_)).
builtin_inline_predicates('$mod'(_,_,_)).
builtin_inline_predicates('$multi'(_,_,_)).
builtin_inline_predicates('$plus'(_,_,_)).
builtin_inline_predicates('$pow'(_,_,_)).
builtin_inline_predicates('$radians'(_,_)).
builtin_inline_predicates('$rint'(_,_)).
builtin_inline_predicates('$round'(_,_)).
builtin_inline_predicates('$shift_left'(_,_,_)).
builtin_inline_predicates('$shift_right'(_,_,_)).
builtin_inline_predicates('$sin'(_,_)).
builtin_inline_predicates('$sqrt'(_,_)).
builtin_inline_predicates('$tan'(_,_)).
builtin_inline_predicates('$float'(_,_)).
builtin_inline_predicates('$float_integer_part'(_,_)).
builtin_inline_predicates('$float_fractional_part'(_,_)).
builtin_inline_predicates('$truncate'(_,_)).
builtin_inline_predicates('$sign'(_,_)).
% Arithmetic comparison
builtin_inline_predicates('$arith_equal'(_,_)).
builtin_inline_predicates('$arith_not_equal'(_,_)).
builtin_inline_predicates('$greater_or_equal'(_,_)).
builtin_inline_predicates('$greater_than'(_,_)).
builtin_inline_predicates('$less_or_equal'(_,_)).
builtin_inline_predicates('$less_than'(_,_)).

builtin_arith_constant(random).
builtin_arith_constant(pi).
builtin_arith_constant(e).

/*****************************************************************
  Eliminate disjunctions
*****************************************************************/
%  The clause a :- b;c is converted into a :- b. and a :- c.
%  In addition, 
%    (C1 -> C2)        is converted into ((C1,!,C2) ; fail).
%    ((C1 -> C2) ; C3) is converted into ((C1,!,C2) ; C3).
%    not(C)            is converted into ((C,!,fail) ; true).
%    \+(C)             is converted into ((C,!,fail) ; true).
%  And then all of disjunctions are eliminated.
%
%  Note: this is based on flatten.pl in holmer's benchmark.

eliminate_disj(Cl, NewCl, DummyCls) :-
	extract_disj(Cl, NewCl, Disjs, []),
	treat_disj(Disjs, DummyCls, []).

extract_disj(Cl, Cl) --> {var(Cl)}, !.
extract_disj(Cl, (H :- NewB)) --> {Cl = (H :- B)}, !,
	extract_disj(B, NewB, Cl).
extract_disj(Cl, Cl) --> !.

extract_disj(G, G, _) --> {var(G)}, !.
extract_disj((G1, G2), (NewG1, NewG2), Cl) --> !,
	extract_disj(G1, NewG1, Cl),
	extract_disj(G2, NewG2, Cl).
extract_disj(G, NewG, Cl) --> {is_disj(G, DisjG)}, !,
	{retract(dummy_clause_counter(N))},
	[disj(DisjG, N, NewG, Cl)],
	{N1 is N+1},
	{assert(dummy_clause_counter(N1))}.
extract_disj(G, G, _) --> !.

is_disj((C1->C2), ((C1,!,C2);fail)) :- !.
is_disj(((C1->C2);C3), ((C1,!,C2);C3)) :- !.
is_disj((C1;C2), (C1;C2)) :- !.
is_disj(not(C),((C,!,fail);true)) :- !.
is_disj(\+(C),((C,!,fail);true)).

treat_disj([]) --> !.
treat_disj([disj((A;B),N,X,C)|Disjs]) -->
	{variables((A;B), Vars)},
	{variables(C, CVars)},
	{intersect_vars(Vars, CVars, Args)},
	{clause(file_name(File), _)},
	{list_to_string(['$dummy_', N, '_', File], Name)},
	{X =.. [Name|Args]},
	{copy_term((X :- A), DummyCla)},
	{copy_term((X :- B), DummyClb)},
	[DummyCla],
	[DummyClb],
	treat_disj(Disjs).

intersect_vars(V1, V2, Out) :-
	sort(V1, Sorted1),
	sort(V2, Sorted2),
	intersect_sorted_vars(Sorted1, Sorted2, Out).

intersect_sorted_vars([], _, []) :- !.
intersect_sorted_vars(_, [], []).
intersect_sorted_vars([X|Xs], [Y|Ys], [X|Rs]) :- X == Y, !,
	intersect_sorted_vars(Xs, Ys, Rs).
intersect_sorted_vars([X|Xs], [Y|Ys], Rs) :- X @< Y, !,
	intersect_sorted_vars(Xs,[Y|Ys],Rs).
intersect_sorted_vars([X|Xs], [Y|Ys], Rs) :- X @> Y, !,
	intersect_sorted_vars([X|Xs],Ys,Rs).

/*****************************************************************
  Utilities
*****************************************************************/
%%% print
pl2am_error(M) :- pl2am_message(['***','PL2ASM','ERROR'|M]).

pl2am_message([]) :- nl, flush_output(user_output).
pl2am_message([M|Ms]) :- write(M), write(' '), pl2am_message(Ms).

%%% format
mode_expr([]).
mode_expr([M|Ms]) :- nonvar(M), pl2am_member(M, [:,+,-,?]), !, mode_expr(Ms).

predspec_expr(F/A) :- atom(F), integer(A).

%%% list
pl2am_append([], Zs, Zs).
pl2am_append([X|Xs], Ys, [X|Zs]) :- pl2am_append(Xs, Ys, Zs).

pl2am_rev(L, R) :- pl2am_rev(L, [], R).
pl2am_rev([], R, R).
pl2am_rev([X|L], Y, R) :- pl2am_rev(L, [X|Y], R).

pl2am_member(X, [X|_]).
pl2am_member(X, [_|Ys]) :- pl2am_member(X, Ys).

pl2am_memq(X, [Y|_]) :- X==Y, !.
pl2am_memq(X, [_|Ys]) :- pl2am_memq(X, Ys).

flatten_list([]) --> !.
flatten_list([L1|L2]) --> !, flatten_list(L1), flatten_list(L2).
flatten_list(L) --> [L].

flatten_code([]) --> !.
flatten_code([(L: C)|Code]) --> !,
	[L: []],
	flatten_code([C|Code]).
flatten_code([Code1|Code2]) --> !,
	flatten_code(Code1),
	flatten_code(Code2).
flatten_code(Code) --> [Code].

%%% transform
conj_to_list(X, _) :-  var(X), !,
	pl2am_error([variable,X,can,not,be,converted,to,'[A|B]',expression]),
	fail.
conj_to_list(((X1,X2),Xs), Y) :- !, conj_to_list((X1,(X2,Xs)), Y).
conj_to_list((X,Xs), [X|Zs]) :- !, conj_to_list(Xs, Zs).
conj_to_list((X), [X]).

list_to_string(List, String) :-
	list_to_chars(List, Chars0),
	flatten_list(Chars0, Chars, []),
	atom_codes(String, Chars).

list_to_chars([], []) :- !.
list_to_chars([L|Ls], [C|Cs]) :- atom(L), !,
	atom_codes(L, C),
	list_to_chars(Ls, Cs).
list_to_chars([L|Ls], [C|Cs]) :- number(L), !,
	number_codes(L, C),
	list_to_chars(Ls, Cs).

list_to_conj(X, Y) :-
	flatten_list(X, L, []),
	list_to_conj0(L, Y).

list_to_conj0(X, _) :- var(X), !,
	pl2am_error([variable,X,can,not,be,converted,to,'(A,B)',expression]),
	fail.
list_to_conj0([X], (X)).
list_to_conj0([X|Xs], (X,Ys)) :- !, list_to_conj0(Xs, Ys).

%%% misc
variables(X, Vs) :- variables(X, [], Vs).

variables(X, Vs, Vs) :- var(X), pl2am_memq(X, Vs), !.
variables(X, Vs, [X|Vs]) :- var(X), !.
variables(X, Vs0, Vs0) :-  atomic(X), !.
variables([X|Xs], Vs0, Vs) :- !, variables(X, Vs0, Vs1), variables(Xs, Vs1, Vs).
variables(X, Vs0, Vs) :- X =.. Xs, variables(Xs, Vs0, Vs).

count_variable(V, X, 1) :- V == X, !.
count_variable(_, X, 0) :- var(X), !.
count_variable(_, X, 0) :- atomic(X), !.
count_variable(V, [X|Y], N) :- !,
	count_variable(V, X, N1),
	count_variable(V, Y, N2),
	N is N1 + N2.
count_variable(V, X, N) :-
	X =.. Xs,
	count_variable(V, Xs, N).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% END
% written by SICStus Prolog 3.12.8