/* File:      flrcompiler.P  -- The Flora Compiler
**
** Author(s): Guizhen Yang
**
** Contact:   flora-users@lists.sourceforge.net
**
** Copyright (C) The Research Foundation of SUNY, 1999-2001
**
** FLORA-2 is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
**
** FLORA-2 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 Library General Public License for
** more details.
**
** You should have received a copy of the GNU Library General Public License
** along with FLORA-2; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
** $Id: flrcompiler.P,v 1.61 2004/08/24 17:47:14 kifer Exp $
**
*/


:- compiler_options([xpp_on]).

#include "flora_errors.flh"
#include "flora_terms.flh"
#include "flora_porting.flh"
#include "flora_exceptions.flh"

#define NEWVAR	        	newvar
#define NEWPREDICATE        	newpredicate
#define NEWOID                  FL_NEWOID_SYM
#define RULE_NUM                rule_num
#define NEWOID_COUNT        	FL_NEWOID_PREFIX
#define TMPDIRECT        	tmpdirect
#define TMPOPTION	        tmpoption
#define COMPILATION_CONTEXT	compcontext

#define  BODYLITERAL     1
#define  HEADLITERAL     2

%% ruleoid is used for numbered anonymous oid generation
:- dynamic ruleoid(_,_,_).
:- dynamic TMPDIRECT(_).
:- dynamic TMPOPTION(_,_).
:- dynamic COMPILATION_CONTEXT(_).

:- index(TMPDIRECT/1,trie).
:- index(TMPOPTION/2,trie).


/****************************************************************************
  utilities
****************************************************************************/
is_flrule(FLRULE(Head,Body),Head,Body).
is_flfact(FLFACT(Head),Head).
is_flquery(FLQUERY(Body),Body).
is_fldirective(FLDIRECTIVE(DirectList,I),DirectList,I).

is_flexport_list(FLEXPORT_LIST(Term),Term).
is_flexport(FLEXPORT(Term,Modules,IsUpdatable),Term,Modules,IsUpdatable).
is_flexport(FLEXPORT(DynamicModule,Term,Modules,IsUpdatable),DynamicModule,Term,Modules,IsUpdatable).

is_fldynrule(FLDYNRULE(Head,Body),Head,Body).

is_flcommand(FLCOMMAND(C),C).
is_flopdef(FLOPDEF(P,A,O),P,A,O).
%%is_flarguments(FLARGUMENTS(F,N,Args),F,N,Args).
is_flprolog(FLPROLOG(F,N),F,N).
is_flindex(FLINDEX(A,P),A,P).
is_flsemantics(FLSEMANTICS(A),A).
is_flsetsemantics(FLSETSEMANTICS(A),A).
is_flcmpopt(FLCMPOPT(OptList),OptList).
is_flignoredep(FLIGNOREDEP(PredList),PredList).
%% These two are used for the build process only--want to get rid of them

is_flconjunct(FLCONJUNCT(L,R),L,R).
is_fldisjunct(FLDISJUNCT(L,R),L,R).
is_flnot(FLNOT(Goal),Goal).
is_fltnot(FLTNOT(Goal),Goal).

is_flload(FLLOAD(LoadList),LoadList).

is_flconstraint(FLCONSTRAINT(ConstrBody),ConstrBody).

%% @module
is_flworkspace(FLWORKSPACE(P,WS),P,WS).
%% (dynrule)@module
is_flruleworkspace(FLRULEWORKSPACE(R,WS),R,WS).
%% P@flora(M)
is_flfloralib(FLFLORALIB(P,M),P,M).
%% flora(M) - the workspace itself
is_flfloralib(FLFLORALIB(Mod), Mod).

%% @prolog(M) and @prolog()
is_flplib(FLPLIB(P,M),P,M).
is_flplib(FLPLIB(P),P).
%% @prologall() and @prologall(module)
%% Make sure the coder translates P2H_PREDICATE/4 as prolog
is_flpliball(FLPLIBALL(P),P) :-
	flora_define_prolog(P2H_PREDICATE,4).
is_flpliball(FLPLIBALL(P,M),P,M) :-
	flora_define_prolog(P2H_PREDICATE,4).

is_flifthenelse(FLIFTHENELSE(Cond,Then,Else),Cond,Then,Else).
is_flifthen(FLIFTHEN(Cond,Then),Cond,Then).

%% Meta ~
is_fluniveqform(FLUNIVEQFORM(Left,Right),Left,Right).
%% Meta =..
is_flmetauniv(FLMETAUNIV(Left,Right),Left,Right).
%% Meta ~..
is_flmetaunivform(FLMETAUNIVFORM(Left,Right),Left,Right).

is_reifyop(FLREIFYOP(Formula),Formula).

%% Control constructs while-do, while-loop, loop-until, do-until,unless-do
is_flcontrolconstruct(FLWHILEDO(Cond,Action),FLLIBWHILEDO,Cond,Action).
is_flcontrolconstruct(FLWHILELOOP(Cond,Action),FLLIBWHILELOOP,Cond,Action).
is_flcontrolconstruct(FLDOUNTIL(Cond,Action),FLLIBDOUNTIL,Cond,Action).
is_flcontrolconstruct(FLLOOPUNTIL(Cond,Action),FLLIBLOOPUNTIL,Cond,Action).
is_flcontrolconstruct(FLUNLESSDO(Cond,Action),FLLIBUNLESSDO,Cond,Action).

is_flterm(FLTERM(Funct,Arity,Args),Funct,Arity,Args).
is_flinsert(FLINSERT(Op,List,Cond),Op,List,Cond).
is_flinsert(FLINSERT(Op,List),Op,List).
is_fldelete(FLDELETE(Op,List,Cond),Op,List,Cond).
is_fldelete(FLDELETE(Op,List),Op,List).

is_fltablerefresh(FLREFRESH(List),List).

is_flclause(FLCLAUSE(Head,Body),Head,Body).
is_flclause(FLCLAUSE(Mode,Head,Body),Mode,Head,Body).

is_flcatch(FLCATCH(Goal,Error,Handler),Goal,Error,Handler).
is_flthrow(FLTHROW(Error),Error).
is_flp2h(FLP2H(Prolog,Hilog),Prolog,Hilog).

is_flnewoidop(FLNEWOIDOP(Var),Var).

%% Op is needed for newmodule only because of its position information 
is_flcallermodule(FLCALLERMODULE(Op,Var),Op,Var).
%% Op is needed for newmodule only because of its position information 
is_flnewmodule(FLNEWMODULE(Op,Module),Op,Module).
is_flupdaterule(FLUPDATERULE(Op,RuleList),Op,RuleList).

is_flaggregate(FLAGGREGATE(Op,V,GV,Goal),Op,V,GV,Goal).

%% Binary relationship, like : or ::
is_flbirelate(FLBIRELATE(Obj1,RelType,Obj2),Obj1,RelType,Obj2).
is_flobjspec(FLOBJSPEC(Obj,Spec),Obj,Spec).
%% Represents object reference: O.M, O..M, O!M, O!!M. RefType is ->, ->>, ...
is_flobjref(FLOBJREF(Obj,RefType,Att),Obj,RefType,Att).

%% RefType represents the arrow type: ->, *->, ->, =>>, ...
is_flfdattspec(FLFDATTSPEC(Att,RefType,Val),Att,RefType,Val).
is_flmvdattspec(FLMVDATTSPEC(Att,RefType,Val),Att,RefType,Val).
is_flincattspec(FLINCATTSPEC(Att,RefType,Val),Att,RefType,Val).
is_fltolistattspec(FLTOLISTATTSPEC(Att,RefType,Val),Att,RefType,Val).
is_flmethspec(FLMETHSPEC(Meth),Meth).
is_flimethspec(FLIMETHSPEC(IMeth),IMeth).
is_fltranspec(FLTRANSPEC(Tran),Tran).

is_flobjeql(FLOBJEQL(O1,O2),O1,O2).
is_flcut(FLCUT(I),I).
is_flpassthru(FLPASSTRU(O),O).

%% basic building blocks
is_flatom(FLATOM(Atom,_I),Atom).
is_flatom(FLATOM(Atom,Index),Atom,Index).
is_flnumber(FLNUMBER(Number,_I),Number).
is_flstring(FLSTRING(String,_I),String).
is_fltoken(FLTOKEN(Token,I),Token,I).
is_fltoken(FLTOKEN(Token,Num,I),Token,Num,I). 

is_flvar(FLVAR(Name,Index),Name,Index).
is_fllist(FLLIST(L,T,I),L,T,I).

is_isaspecop(FL_ISA).
is_subspecop(FL_SUB).
is_fdrefop(FL_FD).
is_ifdrefop(FL_INHERIFD).
is_mvdrefop(FL_MVD).
is_imvdrefop(FL_INHERIMVD).
is_fdspecop(FL_FDARROW).
is_ifdspecop(FL_INFDARROW).
is_mvdspecop(FL_MVDARROW).
is_imvdspecop(FL_INMVDARROW).
is_fdsigspecop(FL_FDSIGARROW).
is_mvdsigspecop(FL_MVDSIGARROW).
is_mvdincspecop(FL_ALLINARROW).
is_imvdincspecop(FL_INALLINARROW).
is_mvdtolistspecop(FL_TOLISTARROW).
is_imvdtolistspecop(FL_INTOLISTARROW).
is_ifdsigspecop(FL_INFDSIGARR).
is_imvdsigspecop(FL_INMVDSIGARR).


/****************************************************************************
  approximate_index(+ParserTerm,-Index)

  It takes a term output from the parser and returns the main index. This
  routine is called when an oid reference is compiled. Since a new variable
  needs to be generated, this main index will represent the textual information
  that corresponds to this new variable.

  Ideally, this procedure should always succeed with a meaningful index,
  since the input is a structure from the parser and corresponds to a
  piece of text in the program file.

  This procedure should be called for a syntax in an oid position.
****************************************************************************/
approximate_index(FLATOM(_Atom,I),I)              :- !.
approximate_index(FLNUMBER(_Number,I),I)          :- !.
approximate_index(FLSTRING(_String,I),I)          :- !.
approximate_index(FLTOKEN(_Token,I),I)            :- !.
approximate_index(FLTOKEN(_Token,_Num,I),I)       :- !.
approximate_index(FLVAR(_Name,I),I)               :- !.
approximate_index(FLLIST(_List,_T,I),I)           :- !.
approximate_index(FLTERM(F,_A,_Args),I)           :- !, approximate_index(F,I).
approximate_index(FLBIRELATE(Obj1,_Rel,_Obj2),I)  :- !, approximate_index(Obj1,I).
approximate_index(FLOBJSPEC(Obj,_Spec),I)         :- !, approximate_index(Obj,I).
approximate_index(FLOBJREF(Obj,_Ref,_Att),I)      :- !, approximate_index(Obj,I).
approximate_index(FLAGGREGATE(Op,_V,_GV,_Goal),I) :- !, approximate_index(Op,I).
approximate_index(FLPLIB(P,_M),I)                 :- !, approximate_index(P,I).
approximate_index(FLPLIB(P),I)                    :- !, approximate_index(P,I).
approximate_index(FLFLORALIB(P,_M),I)             :- !, approximate_index(P,I).
approximate_index(FLWORKSPACE(P,_WS),I)           :- !, approximate_index(P,I).
approximate_index(FLINSERT(Op,_List,_Cond),I)     :- !, approximate_index(Op,I).
approximate_index(FLINSERT(Op,_List),I)           :- !, approximate_index(Op,I).
approximate_index(FLDELETE(Op,_List,_Cond),I)     :- !, approximate_index(Op,I).
approximate_index(FLDELETE(Op,_List),I)           :- !, approximate_index(Op,I).


/****************************************************************************
  encoding utilities
****************************************************************************/
rule_struct(Head,Body,PRRULE(Head,Body)).
fact_struct(Head,PRFACT(Head)).
query_struct(Goal,PRQUERY(Goal)).
directive_struct(Direct,PRDIRECTIVE(Direct)).

dynrule_struct(Head,Body,PRDYNRULE(Head,Body)).

reify_struct(Formula,PRREIFY(Formula)).

command_struct(C,PRCOMMAND(C)).
%% We keep the import directive's support mechanism for @prolog(module)
import_struct(F,N,M,PRIMPORT(F,N,M)).
cmpopt_struct(OptList,PRCMPOPT(OptList)).
ignoredep_struct(SpecList,PRIGNOREDEP(SpecList)).

is_prfact(PRFACT(Head),Head).

%%empty module list, all modules allowed
export_struct(TermList,Code) :-
	florasyslib_struct(_Index,FLLIBEXPORT,_N,[TermList],Code).


/****************************************************************************
  conjunct_struct(+Goal1,+Goal2,-Code)
  disjunct_struct(+Goal1,+Goal2,-Code)
  not_struct(+Goal,-Code)
  tnot_struct(+Goal,-Code)
****************************************************************************/
conjunct_struct(Goal1,Goal2,PRAND(Goal1,Goal2)).
disjunct_struct(Goal1,Goal2,PROR(Goal1,Goal2)).
not_struct(Goal,PRNOT(Goal)).

tnot_struct(Goal,PRTNOT(Goal)) :-
	import_struct((FLORA_TNOT_PREDICATE),1,(flrnegation),ICode),
	directive_struct(ICode,DCode),
	report_directive(DCode).


/****************************************************************************
  conjunct_code(+GoalList,-Code)

  Takes a list of goals and constructs a conjunct:
        prand(G1, prand(G2, G3))
  Discards NULLs
  If all are NULLs, returns NULL.
****************************************************************************/
conjunct_code([Goal],Goal).

conjunct_code([NULL|GList],ConjGoal) :- !, conjunct_code(GList,ConjGoal).

conjunct_code([Goal|GList],ConjGoal) :-
	conjunct_code(GList,ConjGoalTail),
	( ConjGoalTail == NULL ->
	    ConjGoal=Goal
	;
	  conjunct_struct(Goal,ConjGoalTail,ConjGoal)
	).


/****************************************************************************
  encoding routines

  Note: Only primitive structures (atoms, variables, numbers, strings, lists,
        newoids, and cuts) encode the index to the corresponding textual
        information. The compiler directives do not encode any textual
        information. However, not all primitive structures have a meaningful
        index, for instance, new variables that are generated for an oid
        reference. In this case, an index is approximated. In some other
        cases, an atom is generated to encode an internal structure. So there
        is no meaningful index. Then the macro NO_INDEX is encoded as a
        place holder. No textual information should be inferred from the
        NO_INDEX value.
****************************************************************************/
%% basic structures
atomobj_struct(FLATOM(Atom,I),PRATOM(Atom,I)) :- !.
atomobj_struct(Atom,PRATOM(Atom,NO_INDEX)) :- atomic(Atom).
atomobj_struct(Atom,Index,PRATOM(Atom,Index)).

is_atomobj(PRATOM(Atom,I),Atom,I).

atomlit_struct(_Context,FLATOM(Atom,I),PRATOMLIT([Atom],I)) :-
	flora_prlgdef(Atom,_),
	!.
atomlit_struct(Context,FLATOM(Atom,I),PRATOMLIT([Atom,Caller],I)) :-
	determine_caller_info(Context,Caller).

numobj_struct(FLNUMBER(Number,I),PRNUMBER(Number,I)).

varobj_struct(FLVAR(Name,Index),PRVARIABLE(Name,Index)).
varobj_struct(Name,Index,PRVARIABLE(Name,Index)).
varobj_struct(Name,PRVARIABLE(Name,NO_INDEX)).

strobj_struct(FLSTRING(String,I),PRSTRING(String,I)).
newoid_struct(Oid,Index,PRNEWOID(Oid,Index)).
cut_struct(Index,PRCUT(Index)).

list_struct(List,Term,Index,PRLIST(List,Term,Index)).
list_struct(List,Term,PRLIST(List,Term,NO_INDEX)).

workspace_struct(P,WS,PRWORKSPACE(P,WS)).
newpredicate_struct(Name,N,Args,PRNEWPRED(Name,N,Args)).
thismodule_struct(PRTHISMODULE(PRTHISMODULE)).

callerargsterm_struct(Caller,CallerInfo) :-
	(
	  COMPILATION_CONTEXT(literal_workspace(WS)),
	    \+ COMPILATION_CONTEXT(goal_reification)
	-> 
	  compile_workspace_term(WS,ArgsCode)
	;
	    COMPILATION_CONTEXT(goal_reification)
	->  new_varobj(NO_INDEX,ArgsCode)
	; COMPILATION_CONTEXT(rule_reification)
	-> ArgsCode = PRDYNCALLERARGSVAR(PRDYNCALLERARGSVAR)
	; %% non-workspace literal in the body
	    ArgsCode = PRCALLERARGSVAR(PRCALLERARGSVAR)
	),
	list_struct([Caller,PRCALLERARGSTERM(ArgsCode)],[],CallerInfo).

workspaceterm_struct(WS,PRWORKSPACETERM(WSTerm)) :-
	compile_workspace_term(WS,WSTerm).

%% Compiles both user and system workspace terms
compile_workspace_term(WS, CompiledWS) :-
	(is_flatom(WS,_Atom,_I) -> atomobj_struct(WS,CompiledWS)
	; is_flvar(WS,_Var,_I) -> varobj_struct(WS,CompiledWS)
	; is_fltoken(WS,FL_THISMODULE,_) -> thismodule_struct(CompiledWS)
	; is_flfloralib(WS,Mod) -> 
	    compile_workspace_term(Mod,WS1),
	    floralib_struct(WS1, CompiledWS) 
	; %% sometimes WS comes already compiled as a system workspace or a var
	    (floralib_struct(_, WS) ; is_varobj_struct(WS))
	-> WS = CompiledWS
	; flora_error_line('[Compiler] bug: Invalid workspace term, ~w', [WS]),
	    throw(FLORA_TOP_LEVEL)
	).

%% For dynamic rules - workspace of the rule: (rule)@WS
%% Otherwise - current module.
context_module_struct(CallerInfo) :-
	COMPILATION_CONTEXT(ruleworkspace(WSTerm)),
	!,
	callerargsterm_struct(WSTerm,CallerInfo).
context_module_struct(CallerInfo) :-
	COMPILATION_CONTEXT(goal_reification),
	\+ COMPILATION_CONTEXT(rule_reification),
	new_varobj(NO_INDEX,WSTerm),
	!,
	callerargsterm_struct(WSTerm,CallerInfo).
context_module_struct(CallerInfo) :-
	thismodule_struct(WSTerm),
	!,
	callerargsterm_struct(WSTerm,CallerInfo).

%% Represents the special variable, which appears in the rule head, that is
%% bound to the caller name 
callermod_info_structure(Caller) :-
	%% In the head of dynamic rules
	COMPILATION_CONTEXT(ruleworkspace(_)),
	!,
	list_struct([PRDYNCALLERVAR(PRDYNCALLERVAR),
		     PRDYNCALLERARGSVAR(PRDYNCALLERARGSVAR)],
		    [], Caller).
%% In the head of static rules
callermod_info_structure(Caller) :-
	list_struct([PRCALLERVAR(PRCALLERVAR),PRCALLERARGSVAR(PRCALLERARGSVAR)],
		    [], Caller).

callermod_var_structure(PRDYNCALLERVAR(PRDYNCALLERVAR)) :-
	%% In the head of dynamic rules
	COMPILATION_CONTEXT(ruleworkspace(_)),
	!.
%% In the head of static rules
callermod_var_structure(PRCALLERVAR(PRCALLERVAR)).

thisstorage_struct(fdb,PRTHISFDBSTORAGE(PRTHISFDBSTORAGE)).
%% support for checking undefinedness
thisstorage_struct(fld,PRTHISFLDSTORAGE(PRTHISFLDSTORAGE)).

floralib_struct(WS,PRFLORALIB(WS)).
storage_struct(WS,PRFDBSTORAGE(WS)).

determine_caller_info(Context,Caller) :-
	(Context==BODYLITERAL -> context_module_struct(Caller)
	; Context==HEADLITERAL -> callermod_info_structure(Caller)
	%% debug
	; flora_error_line('[Compiler] bug: No caller for this context, ~w', [Context]),
	    throw(FLORA_TOP_LEVEL)
	).
splice_in_caller_argument(Context,Args,NewArgs) :-
	determine_caller_info(Context,Caller),
	flatten([Args,Caller],NewArgs).

termlit_struct(_Context,FObj,N,ObjList,Code) :-
	is_atomobj(FObj,AtomName,_),
	flora_prlgdef(AtomName,_),
	!,
	prologterm_struct(FObj,N,ObjList,Code).
termlit_struct(Context,FObj,N,ObjList,PRTERMLIT(FObj,N1,Args)) :-
	splice_in_caller_argument(Context,ObjList,Args),
	length(Args,N1),
	%% integrity check - debug
	(N1 is N+1, !
	; flora_error_line('[Compiler] bug: Assertion N=N1 failed in termlit structure: Obj=~w, Arity=~w, Args=~w, Context=~w',
			   [FObj,N,ObjList,Context]),
	    throw(FLORA_TOP_LEVEL)
	).


caller_binding_code(Binding,Code) :-
	callermod_var_structure(CallerVar),
	atomobj_struct(FL_SILENT_EQUAL,EqCode),
	prologterm_struct(EqCode,2,[CallerVar,Binding],Code).


/*
   attach_workspace(+WS,+Generator,-GeneratorCode,-WSCode)

   Attaches workspace code to the code produced by Generator
   Generator is a predicate, that produces code for a flora syntactic construct.
   GeneratorCode must be the variable where Generator deposits the code
   it produces.
   WSCode is a var where the final code is produced.
*/
attach_workspace(WS,Generator,GeneratorCode,WSCode) :- 
	set_context(literal_workspace(WS)),
	call(Generator),
	workspacelit_struct(GeneratorCode,WS,WSCode),
	clear_context(literal_workspace(WS)).

workspacelit_struct(P,WS,Code) :-
	thismodule_struct(ThisModuleName),
	(is_flvar(WS,WSVarName,Index) ->
	    varobj_struct(WSVarName,Index,WSVarCode),
	    callerargsterm_struct(ThisModuleName,CallerInfo),
	    %% a call to a Flora user module
	    florasyslib_struct(Index,FLLIBMODLIT,3,[P,WSVarCode,CallerInfo],Code)

	%% X@module or X@flora(module)
        %% or #X@module or #X@flora(module)
	; (is_varobj_struct(P,Index);
           P=PRTERMLIT(PRATOM(FL_TRAN,_TI),2,[PRVARIABLE(_Var,_VI),_Mod]))
	->
	    compile_workspace_term(WS,WSCode),
	    /*
	    (is_flatom(WS,WSAtom,Index) -> atomobj_struct(WSAtom,Index,WSCode)
	    %% ...@ _@
	    ; is_fltoken(WS,FL_THISMODULE,_) -> thismodule_struct(WSCode)
	    ;  WSCode = WS % if system module then it is already compiled
	    ),
	    */
	    set_context(literal_workspace(WS)),
	    callerargsterm_struct(ThisModuleName,CallerInfo),
	    clear_context(literal_workspace(WS)),
	    %% a call to a module
	    florasyslib_struct(Index,FLLIBMODLIT,3,[P,WSCode,CallerInfo],Code)

	; is_flatom(WS,WSAtom,Index) ->
	    atomobj_struct(WSAtom,Index,WSCode),
	    workspace_struct(P,WSCode,Code)

	; is_fltoken(WS,FL_THISMODULE,_) ->
	    thismodule_struct(WSCode),
	    workspace_struct(P,WSCode,Code)
	;
	    %% a Flora system module
	    workspace_struct(P,WS,Code)
	).

%% Is this ever used? This seems to be used in situations where a workspace
%% term appears inside a predicate or a molecule,
%% e.g., p(foo@ws) or a[b->foo@ws].
%% But this use has been DEPRECATED - CHECK!
workspaceobj_struct(P,WS,Object,Code) :-
	abort('Compiler - DEPRECATED!!!!'),
	thismodule_struct(ThisModuleName),
	(is_flvar(WS,WSVarName,Index) ->
	    varobj_struct(WSVarName,Index,WSVarCode),
	    new_varobj(Index,Object),
	    callerargsterm_struct(ThisModuleName,CallerInfo),
	    %% code to construct the object for foo@X in arg position,
	    %% i.e., p(foo@X)
	    florasyslib_struct(Index,FLLIBMODOBJ,4,[P,WSVarCode,CallerInfo,Object],Code)

	; is_varobj_struct(P,Index)
	->
	    compile_workspace_term(WS,WSCode),
	    /*
	    (is_flatom(WS,WSAtom,Index) -> atomobj_struct(WSAtom,Index,WSCode)
	    ; is_fltoken(WS,FL_THISMODULE,_) -> thismodule_struct(WSCode)
	    ;  WSCode = WS % if system module then it is already compiled
	    ),
	    */
	    new_varobj(Index,Object),
	    callerargsterm_struct(ThisModuleName,CallerInfo),
	    %% code to construct the object for X@... in arg position,
	    %% i.e., p(X@...)
	    florasyslib_struct(Index,FLLIBMODOBJ,4,[P,WSCode,CallerInfo,Object],Code)

	; is_flatom(WS,WSAtom,Index) ->
	    atomobj_struct(WSAtom,Index,WSCode),
	    workspace_struct(P,WSCode,Object),
	    Code=NULL

	; is_fltoken(WS,FL_THISMODULE,_) ->
	    thismodule_struct(WSCode),
	    workspace_struct(P,WSCode,Object),
	    Code=NULL
	;
	  %% a Flora system module
	  Code=NULL,
	  workspace_struct(P,WS,Object)
	).

prologterm_struct(F,N,Args,PROLOGTERM(F,N,Args)).

prologliblit_struct(PrologTerm,PROLOGLIBLIT(PrologTerm)).

%% Not all Flora system libraries encode textual information. Only
%% the ones for aggregates and DB updates do.
florasyslib_struct(F,N,Args,FLORASYSLIB(NO_INDEX,F,N,Args)) :-
	report_option(FLSYSLIB(F),NO_INDEX).
florasyslib_struct(Index,F,N,Args,FLORASYSLIB(Index,F,N,Args)) :-
	report_option(FLSYSLIB(F),Index).

is_florasyslib_struct(FLORASYSLIB(I,F,N,Args), I,F,N,Args).

termobj_struct(FObj,N,ObjList,PRTERM(FObj,N,ObjList)).

%% catch{...,...,...}
catch_struct(Goal,Error,Handler,Code) :-
	florasyslib_struct(FLLIBCATCH,3,[Goal,Error,Handler],Code).

%% throw{...}
throw_struct(Error,Code) :-
	florasyslib_struct(FLLIBTHROW,1,[Error],Code).

%% p2h{...}
p2h_struct(Prolog,Hilog,Code) :-
	atomobj_struct(P2H_PREDICATE,P2HCode),
	prologterm_struct(P2HCode,4,[Prolog,Hilog,WRAP_HILOG,P2H_DONOT_UNIFY_VARS],Code).

%% newoid{...}
newoidop_struct(Var,Code) :-
	florasyslib_struct(FLLIBNEWOID,1,[Var],Code).

insert_struct(Op,List,Cond,Code) :-
	%% Index denotes the textual information for the insert
	%% operator and represents the textual information for the
	%% entire insert statement.
	is_flatom(Op,OpAtom,Index),
	insert_syslib(OpAtom,Lib),
	florasyslib_struct(Index,Lib,2,[List,Cond],Code).

insert_struct(Op,List,Code) :-
	%% Index denotes the textual information for the insert
	%% operator and represents the textual information for the
	%% entire insert statement.
	is_flatom(Op,OpAtom,Index),
	insert_syslib(OpAtom,Lib),
	florasyslib_struct(Index,Lib,1,[List],Code).

delete_struct(Op,List,Cond,Code) :-
	%% Index denotes the textual information for the delete
	%% operator and represents the textual information for the
	%% entire delete statement.
	is_flatom(Op,OpAtom,Index),
	delete_syslib(OpAtom,Lib),
	florasyslib_struct(Index,Lib,2,[List,Cond],Code).

delete_struct(Op,List,Code) :-
	%% Index denotes the textual information for the delete
	%% operator and represents the textual information for the
	%% entire delete statement.
	is_flatom(Op,OpAtom,Index),
	delete_syslib(OpAtom,Lib),
	florasyslib_struct(Index,Lib,1,[List],Code).

table_refresh_struct(List,Code) :-
	florasyslib_struct(FLLIBREFRESH,1,[List],Code).

clause_struct(Mode,HeadList,Body,Code) :-
	florasyslib_struct(FLLIBCLAUSE,3,[Mode,HeadList,Body],Code).

/* uncomment to turn on clause{...} for static rules
insert_rulesig_struct(HeadList,Body,Newpred,Code) :-
	florasyslib_struct(FLLIBINSRULESIG,3,[HeadList,Body,Newpred],Code).
*/

insert_syslib(FL_INSERT,FLLIBINSERT) :- !.
insert_syslib(FL_INSERTALL,FLLIBINSERTALL) :- !.

insert_syslib(FL_BTINSERT,FLLIBBTINSERT) :- !.
insert_syslib(FL_BTINSERTALL,FLLIBBTINSERTALL) :- !.

delete_syslib(FL_DELETE,FLLIBDELETE) :- !.
delete_syslib(FL_DELETEALL,FLLIBDELETEALL) :- !.
delete_syslib(FL_ERASE,FLLIBERASE) :- !.
delete_syslib(FL_ERASEALL,FLLIBERASEALL) :- !.

delete_syslib(FL_BTDELETE,FLLIBBTDELETE) :- !.
delete_syslib(FL_BTDELETEALL,FLLIBBTDELETEALL) :- !.
delete_syslib(FL_BTERASE,FLLIBBTERASE) :- !.
delete_syslib(FL_BTERASEALL,FLLIBBTERASEALL) :- !.

updaterule_syslib(FL_INSERTRULE,FLLIBINSERTRULE_Z) :- !.
updaterule_syslib(FL_INSERTRULE_A,FLLIBINSERTRULE_A) :- !.
updaterule_syslib(FL_INSERTRULE_Z,FLLIBINSERTRULE_Z) :- !.
updaterule_syslib(FL_DELETERULE_A,FLLIBDELETERULE_A) :- !.
updaterule_syslib(FL_DELETERULE_Z,FLLIBDELETERULE_Z) :- !.
updaterule_syslib(FL_DELETERULE,FLLIBDELETERULE) :- !.

is_fldeleteruleop(FL_DELETERULE_A) :- !.
is_fldeleteruleop(FL_DELETERULE_Z) :- !.
is_fldeleteruleop(FL_DELETERULE) :- !.

aggregate_struct(Op,V,GV,B,Object,Code) :-
	%% Index denotes the textual information for the aggregate
	%% operator and represents the textual information for the
	%% entire aggregate statement.
	is_flatom(Op,OpAtom,Index),
	aggregate_syslib(OpAtom,Lib),
	new_varobj(Index,Object),
	( GV == [] ->
	    florasyslib_struct(Index,Lib,3,[V,B,Object],Code)
	;
	  florasyslib_struct(Index,Lib,4,[V,GV,B,Object],Code)
        ),
	!.

aggregate_syslib(FL_MIN,FLLIBMIN) :- !.
aggregate_syslib(FL_MAX,FLLIBMAX) :- !.
aggregate_syslib(FL_SUM,FLLIBSUM) :- !.
aggregate_syslib(FL_AVG,FLLIBAVG) :- !.
aggregate_syslib(FL_COUNT,FLLIBCOUNT) :- !.
aggregate_syslib(FL_COLLECTSET,FLLIBCOLLECTSET) :- !.
aggregate_syslib(FL_COLLECTBAG,FLLIBCOLLECTBAG) :- !.

objexists_struct(Context,Obj,PREXISTS(Obj,Caller)) :-
	determine_caller_info(Context,Caller).

birelate_struct(LiteralContext,Obj1,RelType,Obj2,Code) :-
	( is_isaspecop(RelType) ->
	    isaspec_struct(LiteralContext,Obj1,Obj2,Code)
	;
	  is_subspecop(RelType),
	  subspec_struct(LiteralContext,Obj1,Obj2,Code)
        ).

isaspec_struct(Context,Obj1,Obj2,PRISA(Obj1,Obj2,Caller)) :-
	determine_caller_info(Context,Caller).

subspec_struct(Context,Obj1,Obj2,PRSUB(Obj1,Obj2,Caller)) :-
	determine_caller_info(Context,Caller).


fdattspec_struct(LiteralContext,Object,AttObj,RefType,ValObj,Code) :-
	(
	  is_fdspecop(RefType) ->
	    fdspec_struct(LiteralContext,Object,AttObj,ValObj,Code)
	; is_ifdspecop(RefType) ->
	    ifdspec_struct(LiteralContext,Object,AttObj,ValObj,Code)
        ).

fdspec_struct(Context,Object,AttObj,ValObj,PRFD(Object,AttObj,ValObj,Caller)) :-
	determine_caller_info(Context,Caller).

ifdspec_struct(Context,Object,AttObj,ValObj,PRIFD(Object,AttObj,ValObj,Caller)) :-
	determine_caller_info(Context,Caller).

%% This is called when someting like a.b[]@module is compiled.
%% Why is compilation different from body_objref_struct, which is used for
%% a.b[] (without the module)?
objattdef_struct(LiteralContext,Obj,RefType,Att,Code) :-
	( is_fdrefop(RefType) ->
	    fddef_struct(LiteralContext,Obj,Att,Code)

	; is_ifdrefop(RefType) ->
	    ifddef_struct(LiteralContext,Obj,Att,Code)

	; is_mvdrefop(RefType) ->
	    mvddef_struct(LiteralContext,Obj,Att,Code)
	;
	  is_imvdrefop(RefType),
	  imvddef_struct(LiteralContext,Obj,Att,Code)
        ).

%% This is for ->>, *->>, =>, *=>, =>>, *=>> when the attribute is defined,
%% but its value is empty set
mvdattdef_struct(LiteralContext,Object,AttObj,RefType,Code) :-
	( is_mvdspecop(RefType) ->
	    mvddef_struct(LiteralContext,Object,AttObj,Code)
	;
	  is_imvdspecop(RefType),
	    imvddef_struct(LiteralContext,Object,AttObj,Code)

	; is_mvdsigspecop(RefType) ->
	    mvdsigdef_struct(LiteralContext,Object,AttObj,Code)

	; is_imvdsigspecop(RefType) ->
	    imvdsigdef_struct(LiteralContext,Object,AttObj,Code)

	; is_fdsigspecop(RefType) ->
	    fdsigdef_struct(LiteralContext,Object,AttObj,Code)

	; is_ifdsigspecop(RefType) ->
	    ifdsigdef_struct(LiteralContext,Object,AttObj,Code)
        ).

fddef_struct(Context,Object,AttObj,PRFDDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
ifddef_struct(Context,Object,AttObj,PRIFDDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
mvddef_struct(Context,Object,AttObj,PRMVDDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
imvddef_struct(Context,Object,AttObj,PRIMVDDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
mvdsigdef_struct(Context,Object,AttObj,PRMVDSIGDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
imvdsigdef_struct(Context,Object,AttObj,PRIMVDSIGDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
fdsigdef_struct(Context,Object,AttObj,PRFDSIGDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).
ifdsigdef_struct(Context,Object,AttObj,PRIFDSIGDEF(Object,AttObj,Caller)) :-
		determine_caller_info(Context,Caller).

mvdattspec_struct(LiteralContext,Object,AttObj,RefType,ValObj,Code) :-
	(
	  is_mvdspecop(RefType) ->
	    mvdspec_struct(LiteralContext,Object,AttObj,ValObj,Code)

	; is_imvdspecop(RefType) ->
	    imvdspec_struct(LiteralContext,Object,AttObj,ValObj,Code)

	; is_mvdsigspecop(RefType) ->
	    mvdsigspec_struct(LiteralContext,Object,AttObj,ValObj,Code)

	; is_imvdsigspecop(RefType) ->
	    imvdsigspec_struct(LiteralContext,Object,AttObj,ValObj,Code)

	%% Note: => and *=> are permitted to have multiple values
	%%       (semantics is intersection)
	; is_fdsigspecop(RefType) ->
	    fdsigspec_struct(LiteralContext,Object,AttObj,ValObj,Code)

	; is_ifdsigspecop(RefType) ->
	    ifdsigspec_struct(LiteralContext,Object,AttObj,ValObj,Code)
        ).

mvdspec_struct(Context,Object,AttObj,ValObj,PRMVD(Object,AttObj,ValObj,Caller)) :-
		determine_caller_info(Context,Caller).
imvdspec_struct(Context,Object,AttObj,ValObj,PRIMVD(Object,AttObj,ValObj,Caller)) :-
		determine_caller_info(Context,Caller).
mvdsigspec_struct(Context,Object,AttObj,ValObj,PRMVDSIG(Object,AttObj,ValObj,Caller)) :-
		determine_caller_info(Context,Caller).
imvdsigspec_struct(Context,Object,AttObj,ValObj,PRIMVDSIG(Object,AttObj,ValObj,Caller)) :-
		determine_caller_info(Context,Caller).
fdsigspec_struct(Context,Object,AttObj,ValObj,PRFDSIG(Object,AttObj,ValObj,Caller)) :-
		determine_caller_info(Context,Caller).
ifdsigspec_struct(Context,Object,AttObj,ValObj,PRIFDSIG(Object,AttObj,ValObj,Caller)) :-
		determine_caller_info(Context,Caller).

%% for +>> and *+>>
%% appears only in the rule body
incattspec_struct(Object,AttObj,RefType,ValObj,Code) :-
	( is_mvdincspecop(RefType) ->
	    mvdincspec_struct(Object,AttObj,ValObj,Code)
	;
	  is_imvdincspecop(RefType),
	  imvdincspec_struct(Object,AttObj,ValObj,Code)
        ).

%% +>>
%% appears only in the rule body
mvdincspec_struct(Object,AttObj,ValObj,PRMVDINC(Object,AttObj,ValObj,CallerInfo)) :-
	thismodule_struct(ThisModule),
	callerargsterm_struct(ThisModule,CallerInfo).
%% *+>>
%% appears only in the rule body
imvdincspec_struct(Object,AttObj,ValObj,PRIMVDINC(Object,AttObj,ValObj,CallerInfo)) :-
	thismodule_struct(ThisModule),
	callerargsterm_struct(ThisModule,CallerInfo).

%% ->->, *->->
%% appears only in the rule body
tolistattspec_struct(Object,AttObj,RefType,ValObj,Code) :-
	( is_mvdtolistspecop(RefType) ->
	    mvdtolistspec_struct(Object,AttObj,ValObj,Code)
	;
	  is_imvdtolistspecop(RefType),
	  imvdtolistspec_struct(Object,AttObj,ValObj,Code)
        ).

mvdtolistspec_struct(Object,AttObj,ValObj,PRMVDTOLIST(Object,AttObj,ValObj,CallerInfo)) :-
	thismodule_struct(ThisModule),
	callerargsterm_struct(ThisModule,CallerInfo).
imvdtolistspec_struct(Object,AttObj,ValObj,PRIMVDTOLIST(Object,AttObj,ValObj,CallerInfo)) :-
	thismodule_struct(ThisModule),
	callerargsterm_struct(ThisModule,CallerInfo).

%% This is called when someting like a.b[] is compiled.
body_objref_struct(Obj,RefType,Att,Index,Val,Code) :-
	%% Index is the approximate textual information
	%% for the new variable that represents an oid.
	new_varobj(Index,Val),
	( is_fdrefop(RefType) ->
	    fdspec_struct(BODYLITERAL,Obj,Att,Val,Code)

	; is_ifdrefop(RefType) ->
	    ifdspec_struct(BODYLITERAL,Obj,Att,Val,Code)

	; is_mvdrefop(RefType) ->
	    mvdspec_struct(BODYLITERAL,Obj,Att,Val,Code)
	;
	  is_imvdrefop(RefType),
	  imvdspec_struct(BODYLITERAL,Obj,Att,Val,Code)
        ).

head_objref_struct(Obj,RefType,Att,Index,Val,Code) :-
	( is_fdrefop(RefType) ->
	    fdskolem_struct(Obj,Att,Index,Val),
	    fdspec_struct(HEADLITERAL,Obj,Att,Val,Code)
	;
	  is_ifdrefop(RefType),
	  ifdskolem_struct(Obj,Att,Index,Val),
	  ifdspec_struct(HEADLITERAL,Obj,Att,Val,Code)
        ).

%% Skolem functions also encode textual information.
fdskolem_struct(Obj,Att,Index,PRFDSKOLEM(Obj,Att,Index)) :-
	report_option(FLSKOLEM,Index).
ifdskolem_struct(Obj,Att,Index,PRIFDSKOLEM(Obj,Att,Index)) :-
	report_option(FLSKOLEM,Index).

methspec_struct(Context,Obj,Meth,PRMETH(Obj,Meth,Caller)) :-
	determine_caller_info(Context,Caller).
imethspec_struct(Context,Obj,IMeth,PRIMETH(Obj,IMeth,Caller)) :-
	determine_caller_info(Context,Caller).
transpec_struct(Context,Obj,Tran,PRTRAN(Obj,Tran,Caller)) :-
	determine_caller_info(Context,Caller).

objeql_struct(Context,O1,O2,PROBJEQL(O1,O2,Caller)) :-
	determine_caller_info(Context,Caller).


ifthenelse_struct(Cond,Then,Else,Code) :-
	florasyslib_struct(FLLIBIFTHENELSE,3,[Cond,Then,Else],Code).

ifthen_struct(Cond,Then,Code) :-
	florasyslib_struct(FLLIBIFTHEN,2,[Cond,Then],Code).

univeqform_struct(Left,Right,Code) :-
	florasyslib_struct(FLLIBUNIVEQFORM,2,[Left,Right],Code).

%% This handles both ~.. and =..
%% These predicates are defined identically. The only difference is that
%% the LHS arg of ~.. is compiled as meta, while in =.. it is compiled as oid
metauniv_struct(Left,Right,Code) :-
	florasyslib_struct(FLLIBMETAUNIV,2,[Left,Right],Code).

%% encoding for control constructs
controlconstruct_struct(CondCode,ActionCode,Wrapper,Code) :-
	florasyslib_struct(Wrapper,2,[CondCode,ActionCode],Code).

constraint_struct(ConstrCode,PRCONSTRAINT(ConstrCode)).


/****************************************************************************
  reset_newpredicate/0
  new_predicate(-Name)
****************************************************************************/
reset_newpredicate :- flora_set_counter(NEWPREDICATE,1).

new_predicate(Name) :-
	flora_increment_counter(NEWPREDICATE,1,OldVal,_NewVal),
	number_codes(OldVal,OldValLst),
	atom_codes(OldValAtm,OldValLst),
	flora_concat_atoms([NEWPREDICATE,OldValAtm],Name).


/****************************************************************************
  reset_newvar/0
  new_varobj(-CompiledVarObj)
  new_varobjlist(+Number,-List)
****************************************************************************/
reset_newvar :- flora_set_counter(NEWVAR,1).

new_varobj(Index,VarObj) :-
	flora_increment_counter(NEWVAR,1,OldVal,_NewVal),
	number_codes(OldVal,OldValLst),
	atom_codes(OldValAtm,OldValLst),
	flora_concat_atoms([NEWVAR,OldValAtm],Name),
	varobj_struct(Name,Index,VarObj).


new_varobjlist(0,[]) :- !.

new_varobjlist(N,[VarObj|L]) :-
	new_varobj(NO_INDEX,VarObj),
	M is N-1,
	new_varobjlist(M,L).


/****************************************************************************
  reset_newoid/0
  new_oidobj(+Index,-OidObject)
****************************************************************************/
reset_newoid :- flora_set_counter(NEWOID_COUNT,1).

new_oidobj(Index,OidObject) :-
	flora_increment_counter(NEWOID_COUNT,1,OldVal,_NewVal),
	number_codes(OldVal,OldValLst),
	atom_codes(OldValAtm,OldValLst),
	flora_concat_atoms([NEWOID,OldValAtm],Name),
	newoid_struct(Name,Index,OidObject).

/*************************************************************************
  new_oidobj(+RuleNum,+OidNumStr,+Index,-OidObject) :-
*************************************************************************/
new_oidobj(RuleNum,OidNumStr,Index,OidObject) :-
	(
	ruleoid(OidNumStr,_,Count)
	-> Count_new is Count+1,
	   retract(ruleoid(OidNumStr,_,Count)),
	   assert(ruleoid(OidNumStr,Index,Count_new))
	;  assert(ruleoid(OidNumStr,Index,1))
	), 
	number_codes(RuleNum,RuleNumLst),
	atom_codes(RuleNumAtm,RuleNumLst),
        flora_concat_atoms([NEWOID,RuleNumAtm,'|',OidNumStr],Name),
	newoid_struct(Name,Index,OidObject).


/****************************************************************************
  reset_rulenum

****************************************************************************/
reset_rulenum :- flora_set_counter(RULE_NUM,1).


/****************************************************************************
  allvars(+CompilerTerm,-Vars)
  collects all variables in a term (or a list of terms) into the list Vars.

  allvars(+CompilerTerm,-Vars,-TailVars)
****************************************************************************/
is_atomobj_struct(PRATOM(_Atom,_I)).
is_numobj_struct(PRNUMBER(_Number,_I)).
is_varobj_struct(PRVARIABLE(_Name,_I)).
is_varobj_struct(PRVARIABLE(_Name,Index),Index).
is_strobj_struct(PRSTRING(_String,_I)).

allvars(Term,Vars) :-
	allvars(Term,Vs,[]),
	sort(Vs,Vars).


allvars(Term,Vars,Vars) :-
	(var(Term); atomic(Term)),
	!.

allvars([],Vars,Vars) :- !.

allvars([H|L],Vars,TVars) :-
	!,
	allvars(H,Vars,LVars),
	allvars(L,LVars,TVars).

allvars(Term,[Term|Vars],Vars) :-
	is_varobj_struct(Term),
	!.

allvars(Term,Vars,Vars) :-
	( is_atomobj_struct(Term);
	  is_numobj_struct(Term);
	  is_strobj_struct(Term)
        ),
	!.

allvars(Term,Vars,TVars) :-
	Term =.. [_F|L],
	allvars(L,Vars,TVars).


/****************************************************************************
  error and warning messages
****************************************************************************/
compiling_error(Index,Msg,error(Index,Msg)).

compiling_warning(Index,Msg,warning(Index,Msg)).


/****************************************************************************
  collect_vars(+ParserTermOrList,-Vars)
  collects all occurrences of variables in a parser term (or a list of parser
  terms) into the list Vars.

  collect_vars(+ParserTerm,-Vars,-TailVars)
****************************************************************************/
collect_vars(ParserTermOrList,Vars) :-
	collect_vars(ParserTermOrList,Vars,[]).

collect_vars(ParserTerm,Vars,Vars) :-
	(var(ParserTerm); atomic(ParserTerm)),
	!.

collect_vars([],Vars,Vars) :- !.

collect_vars([H|L],Vars,TVars) :-
	!,
	collect_vars(H,Vars,LVars),
	collect_vars(L,LVars,TVars).

collect_vars(ParserTerm,[ParserTerm|Vars],Vars) :-
	is_flvar(ParserTerm,_Name,_Index),
	!.

collect_vars(ParserTerm,Vars,Vars) :-
	( is_flatom(ParserTerm,_Atom);
	  is_flnumber(ParserTerm,_Number);
	  is_flstring(ParserTerm,_String);
	  is_fltoken(ParserTerm,_Token,_I);
	  is_fltoken(ParserTerm,_Token,_Num,_I) 
        ),
	!.

collect_vars(ParserTerm,Vars,TVars) :-
	ParserTerm =.. [_F|L],
	collect_vars(L,Vars,TVars).

/****************************************************************************
  subtract_vars(+VarsList1,+VarsList2,-VarsList)
  subtracts the VarsList2 from VarsList1, both of which contain parser term.
  The result is a list of variables whose names do not appear in VarsList2.
  Anonymous variables are considered as distinct names.
****************************************************************************/
subtract_vars([],_,[]) :- !.

subtract_vars([H|T1],L,[H|T2]) :-
	is_flvar(H,FL_UNDERSCORE,_I),
	!,
	subtract_vars(T1,L,T2).

subtract_vars([H|T],L,V) :-
	is_flvar(H,N,_I),
	is_flvar(X,N,_J),
	member(X,L),
	!,
	subtract_vars(T,L,V).

subtract_vars([H|T1],L,[H|T2]) :-
	subtract_vars(T1,L,T2).


/****************************************************************************
  collect_namevars(+ParserTerm,-QueryVars)
  collects all the queryable variables (those that do not start with an
  underscore) in a parser term (or a list of parser terms) into a list
  of Name=Var constructs.

  indexvars(+SortedNameVars,-IndexVars)
  namevars(+SortedIndexVars,-QueryVars)
****************************************************************************/
collect_namevars(ParserTerm,QueryVars) :-
	collect_vars(ParserTerm,NameVs),
	sort(NameVs,SortedNameVs),
	indexvars(SortedNameVs,IndexVs),
	keysort(IndexVs,SortedIndexVs),
	namevars(SortedIndexVs,QueryVars).


indexvars([],[]) :- !.

indexvars([T|L],Vars) :-
	is_flvar(T,Name,I),
	( flora_match_substring(FL_UNDERSCORE,Name,0) ->
	    indexvars(L,Vars)
	;
	  Vars=[I-Name|Vs],
	  remove_dupvars(L,Name,VL),
	  indexvars(VL,Vs)
        ).


namevars([],[]) :- !.

namevars([Index-Name|L],[NV|NVs]) :-
	varobj_struct(Name,Index,VCode),
	atomobj_struct(Name,Index,NCode),
	atomobj_struct(FL_UNIVEQ,FCode),
	prologterm_struct(FCode,2,[NCode,VCode],NV),
	namevars(L,NVs).


/****************************************************************************
  singleton_vars(+SortedVarsList,-SingletonVars)
  collects all the singleton variables in SortedVarsList into SingletonVars.
  Singleton variables collected here exclude those
  beginning with a underscore and the anonymous.

  remove_dupvars(+SortedVarsList,+VarName,-Vars)
****************************************************************************/
singleton_vars([],[]) :- !.

singleton_vars([V|L],[V|Vs]) :-
	is_flvar(V,FL_UNDERSCORE,_I),
	!,
	singleton_vars(L,Vs).

singleton_vars([V],[V]) :- !.

singleton_vars([V1,V2|L],Vars) :-
	( is_flvar(V1,Name,_I), is_flvar(V2,Name,_J) ->
	    remove_dupvars(L,Name,Vs),
	    singleton_vars(Vs,Vars)
	;
	  Vars=[V1|Vs],
	  singleton_vars([V2|L],Vs)
        ).


remove_dupvars([V|L],Name,Vars) :-
	is_flvar(V,Name,_I),
	!,
	remove_dupvars(L,Name,Vars).

remove_dupvars(Vars,_Name,Vars).


/****************************************************************************
  singleton_warning(+VarList,-WarnList,-WarnTail)
  Warnings are not generated for variables beginning with an underscore.
****************************************************************************/
singleton_warning([],WarnList,WarnList).

singleton_warning([V|L],WarnList,WarnTail) :-
	is_flvar(V,Name,I),
	( flora_match_substring(FL_UNDERSCORE,Name,0) ->
	    singleton_warning(L,WarnList,WarnTail)
	;
	  compiling_warning(I,SINGLETON_VAR,W),
	  WarnList=[W|T],
	  singleton_warning(L,T,WarnTail)
        ).


/****************************************************************************
  unbound_warning(+VarList,-WarnList,-WarnTail)
  Warnings are not generated for variables beginning with an underscore.
****************************************************************************/
unbound_warning([],WarnList,WarnList).

unbound_warning([V|L],WarnList,WarnTail) :-
	is_flvar(V,Name,I),
	( flora_match_substring(FL_UNDERSCORE,Name,0) ->
	    unbound_warning(L,WarnList,WarnTail)
	;
	  compiling_warning(I,UNBOUND_VAR,W),
	  WarnList=[W|T],
	  unbound_warning(L,T,WarnTail)
        ).


/****************************************************************************
  check_vars(+HeadTermList,+BodyTerm,-Status)
****************************************************************************/
check_vars(HeadTermList,BodyTerm,Status) :-
	collect_vars(HeadTermList,HeadVars),
	collect_vars(BodyTerm,BodyVars),
	append(HeadVars,BodyVars,Vars),
	sort(Vars,SortedVars),
	singleton_vars(SortedVars,SingletonVars),
	singleton_warning(SingletonVars,Status,WarnTail),
	subtract_vars(HeadVars,BodyVars,UnboundVars),
	%% Don't issue the unbound var in the head warning for facts
	(BodyTerm \= [] ->
	    unbound_warning(UnboundVars,WarnTail,[])
	;
	    true
	).


/****************************************************************************
  clear_directive
  get_directive(-L)  
  report_directive(+Direct)
  clear_options
  get_options(-L)
  report_option(+Option,+Index)
****************************************************************************/
clear_directive :- retractall(TMPDIRECT(_)).
get_directive(L) :- findall(D,TMPDIRECT(D),L).
report_directive(Direct) :- assert(TMPDIRECT(Direct)).


clear_options :- retractall(TMPOPTION(_,_)).
get_options(L) :- findall((O,Idx),TMPOPTION(O,Idx),L).
report_option(Option,Idx) :-
	assert(TMPOPTION(Option,Idx)).

clear_context(X) :- retractall(COMPILATION_CONTEXT(X)).
set_context(X) :- assert(COMPILATION_CONTEXT(X)).

%% Report options specified in the :- setsemantics{...} directive
%% Since the argument is a parser list (sans the FLLIST wrapper), we need 
%% to extract the actual values of terms in the list in order to pass
%% to report_options/2.
report_semantic_options([]).
report_semantic_options([H|T]) :-
	is_flplib(H,FlTerm),
	is_flterm(FlTerm,Funct,_N,[Arg|_]),
	is_flatom(Funct,FunctVal,Index),
	is_flatom(Arg,ArgVal),
	Option =.. [FunctVal,ArgVal],
	report_option(Option,Index),
	report_semantic_options(T).


/****************************************************************************
  initialize_work
****************************************************************************/
initialize_work :-
	reset_newvar,
	clear_directive,
	clear_options,
	clear_context(_).

/****************************************************************************
  flora_reset_compiler/0
****************************************************************************/
flora_reset_compiler :-
	reset_newpredicate,
	reset_rulenum,
	reset_newoid.

/****************************************************************************
  flora_compile_add(+ParserTerm,-CodeDiffList,-OptionList,-Status)

  This is the top level predicate that is called to compile code for
  adding code to module.

  CodeDiffList is a difference list in the form of [...|T]-T. It is for
  the optimization of append.
****************************************************************************/
flora_compile_add(NULL,X-X,[],[]) :- !.

flora_compile_add(ParserTerm,CodeDiffList,OptionList,Status) :-
	%% extract the rule number
	flora_increment_counter(RULE_NUM,1,_,_),
	initialize_work,
	( is_flrule(ParserTerm,Head,Body) ->
	    compile_rule_add(Head,Body,CodeDiffList,Status)

	; is_flfact(ParserTerm,Head) ->
	    compile_fact(Head,CodeDiffList,Status)


	; is_flquery(ParserTerm,Body) ->
	    compile_query(Body,CodeDiffList,Status)

	; is_fldirective(ParserTerm,DirectList,DirctIdx) ->
	    compile_directive_add(DirectList,DirctIdx,CodeDiffList,Status)
        ),
	!,
	get_options(OptionList),
	retractall(ruleoid(_,_,_)).
	
%% This rule is for debugging.
flora_compile_add(_ParserTerm,[],[],[error(UNKNOWN_ERROR)]).


compile_rule_add(Head,Body,[Code|ListTail]-ListTail,Status):-
	    compile_flupdaterule(FLATOM(FL_INSERTRULE_Z,NO_INDEX),[FLDYNRULE(Head,Body)],RuleCode,Status),
	    query_struct(RuleCode,Code).


compile_directive_add([],_,T-T,[]) :- !.

compile_directive_add([D|L],DirIdx,CodeList-ListTail,Status) :-
	compile_direct_add(D,DirIdx,DCodeList,S),
	( S == [] ->
	    append(DCodeList,T,CodeList),
	    compile_directive_add(L,DirIdx,T-ListTail,Status)
	;
	  Status=S
        ).

compile_direct_add(DirectTerm,_DirIdx,[Code],S) :-
	is_flsetsemantics(DirectTerm,_OptionsList),
	!,
	compile_exec_directive([DirectTerm],NULL,Code1,S),
	query_struct(Code1,Code).

compile_direct_add(DirectTerm,DirIdx,DCodeList,S) :-
	compile_direct(DirectTerm,DirIdx,DCodeList,S).

/****************************************************************************
  flora_compile(+ParserTerm,-CodeDiffList,-OptionList,-Status)

  This is the top level procedure that is called to compile code.

  CodeDiffList is a difference list in the form of [...|T]-T. It is for
  the optimization of append.
****************************************************************************/
flora_compile(NULL,X-X,[],[]) :- !.

flora_compile(ParserTerm,CodeDiffList,OptionList,Status) :-
	%% extract the rule number
	flora_increment_counter(RULE_NUM,1,_,_),
	initialize_work,
	( is_flrule(ParserTerm,Head,Body) ->
	    compile_rule(Head,Body,CodeDiffList,S),
	    %% check whether singleton numbered anon oid exists
	    (ruleoid(_,_,1) -> referenced_once(S,Stat);  Stat=S)

	; is_flfact(ParserTerm,Head) ->
	    compile_fact(Head,CodeDiffList,S),
	    (ruleoid(_,_,1) -> referenced_once(S,Stat);  Stat=S)

	; is_flquery(ParserTerm,Body) ->
	    compile_query(Body,CodeDiffList,Stat)

	; is_fldirective(ParserTerm,DirectList,DirctIdx) ->
	    compile_directive(DirectList,DirctIdx,CodeDiffList,Stat)
        ),
	!,
        %% append warnings generated by dynamic rules to Status
        append_dynrule_warnings(Stat,Status),
	get_options(OptionList),
	retractall(ruleoid(_,_,_)).
	
%% This rule is for debugging.
flora_compile(_ParserTerm,[],[],[error(UNKNOWN_ERROR)]).


/***************************************************************************
  append_dynrule_warnings(+Status,-NewStatus)
  append warnings on dynamic rules
***************************************************************************/
append_dynrule_warnings(Status,NewStatus) :-
        dynrule_warnings(Warn),
        !,
        retract(dynrule_warnings(Warn)),
        append(Status,Warn,TmpStatus),
        append_dynrule_warnings(TmpStatus,NewStatus).

append_dynrule_warnings(Status,Status).

/***************************************************************************
  referenced_once(+Status_rf,-Status)
  finds singleton numbered anon oid and puts warning message in Status
***************************************************************************/
referenced_once(Status_rf,Status) :-
	findall(Index,ruleoid(_,Index,1),IndexList),
	singleton_oid_warning(IndexList,WarnList,[]),
	append(Status_rf,WarnList,Status).


/*************************************************************************
singleton_oid_warning(+SingleOidList,-WarnList,-WarnTail)
***********************************************************************/
singleton_oid_warning([],WarnList,WarnList).

singleton_oid_warning([Index|L],WarnList,WarnTail) :-
	compiling_warning(Index,SINGLETON_OID,W),
	WarnList=[W|T],
	singleton_oid_warning(L,T,WarnTail).


/****************************************************************************
  compile_directive(+DirectList,+DirctIdx,-CodeDiffList,-Status)
  compile_direct(DirectTerm,+DirctIdx,-CodeList,Status)
****************************************************************************/
compile_directive([],_,T-T,[]) :- !.

compile_directive([D|L],DirIdx,CodeList-ListTail,Status) :-
	compile_direct(D,DirIdx,DCodeList,S),
	( S == [] ->
	    append(DCodeList,T,CodeList),
	    compile_directive(L,DirIdx,T-ListTail,Status)
	;
	  Status=S
        ).


%% Some directives imply additional code.
compile_direct(DirectTerm,_DirIdx,[Code|ImpliedCode],[]) :-
	( is_flcommand(DirectTerm,C) ->
	    command_struct(C,Direct),
	    ImpliedCode = []

	 ; is_flexport_list(DirectTerm,Term) ->
	    compile_export(Term,Direct)
        ),
	!,
	directive_struct(Direct,Code).

compile_direct(DirectTerm,DirIdx,[],[]) :-
	is_flindex(DirectTerm,A,P),
	report_option(FLINDEX(A,P),DirIdx),
	!.

%% Operator definition. Must also induce executable op definition,
%% to execute in the shell (restricted to "main" module)
compile_direct(DirectTerm,_DirIdx,[Code],Status) :-
	is_flopdef(DirectTerm,P,A,O),
	flora_define_operator(P,A,O),
	compile_exec_directive([FLOPDEF(P,A,O)],NULL,Code1,Status),
	query_struct(Code1,Code),
	!.

%% Operator definition. Must also induce executable args definition,
%% to execute in the shell (restricted to "main" module)
/** DEPRECATED
compile_direct(DirectTerm,[Code],Status) :-
	is_flarguments(DirectTerm,P,N,A),
	flora_define_arguments(P,N,A),
	compile_exec_directive([FLARGUMENTS(P,N,A)],NULL,Code1,Status),
	query_struct(Code1,Code),
	!.
**/

compile_direct(DirectTerm,_Idx,[],[]) :-
	is_flprolog(DirectTerm,P,N),
	flora_define_prolog(P,N),
	!.

compile_direct(DirectTerm,_Idx,CodeList,[]) :-
	is_flsetsemantics(DirectTerm,OptionsList),
	!,
	is_fllist(OptionsList,L,_T,_I),
	%%compile_fllist(L,T,I,OptionListCode,_OidCode,_Code,Status),
	report_semantic_options(L),
	CodeList = [],
	!.

%% :- compiler_options
compile_direct(DirectTerm,Idx,[Code],[]) :-
	is_flcmpopt(DirectTerm,OptList),
	( member(XSB_SPECREPR,OptList) ->
	    report_option(XSB_SPECREPR,Idx)
	;
	    true
	),
	cmpopt_struct(OptList,OCode),
	directive_struct(OCode,Code),	
	!.
	
%% :- ignore_depchk
compile_direct(DirectTerm,_Idx,[Code],Status) :-
	is_flignoredep(DirectTerm,SpecList),
	compile_ignoredep_list(SpecList,SCode,Status),
        !,
        ( Status == [] ->
	    ignoredep_struct(SCode,ICode),
	    directive_struct(ICode,Code)
        ;   true
        ).


/****************************************************************************
  compile_ignoredep_list(+SpecList,-CodeList,-Status)
  compile a list of ignoredep sepcifications
****************************************************************************/
compile_ignoredep_list([],[],[]) :- !.
compile_ignoredep_list([H|L],[HCode|LCode],Status) :-
        compile_body(H,HCode,S),
        ( S == [] ->
            compile_ignoredep_list(L,LCode,Status)
        ;
            Status = S
        ).


/****************************************************************************
  compile_flatomvar(+T,-Code)

  T is a variable structure, or an atom structure, or a plain atomic.
****************************************************************************/
compile_flatomvar(T,Code) :-
	    ( is_flvar(T,TName,I) ->
		varobj_struct(TName,I,Code)
	    ; 
	      atomobj_struct(T,Code)
	    ).

/*
compile_flatomvar_list([],[]) :- !.
compile_flatomvar_list([H|T],[HCode|TCode]) :-
	compile_flatomvar(H,HCode),
	compile_flatomvar_list(T,TCode).
*/


/****************************************************************************
  compile_fact(+Head,-CodeDiffList,-Status)

  CodeDiffList is a difference list in the form of [...|T]-T. It is for
  the optimization of append.
****************************************************************************/
compile_fact(Head,CodeDiffList,Status) :-
	set_context(compiling_facts),
	compile_head(Head,HeadCode,S),
	( S == [] ->
	    compile_factlist(HeadCode,CodeDiffList),
	    check_vars(Head,[],Status)
        ;
	  Status=S
	),
	clear_context(compiling_facts).


/****************************************************************************
  compile_factlist(+Code,-CodeDifferenceList)

  This procedure takes a conjucntion of atoms and splits into a
  difference list.
****************************************************************************/
compile_factlist(NULL,CodeList-CodeList) :- !.

compile_factlist(ConjunctCode,CodeList-ListTail) :-
	conjunct_struct(F1,F2,ConjunctCode),
	!,
	compile_factlist(F1,CodeList-T),
	compile_factlist(F2,T-ListTail).

compile_factlist(F,[FCode|ListTail]-ListTail) :-
	!,
	fact_struct(F,FCode).


/****************************************************************************
  compile_query(+Body,-CodeDiffList,-Status)

  CodeDiffList is a difference list in the form of [...|T]-T. It is for
  the optimization of append.
****************************************************************************/
compile_query(Body,CodeList-ListTail,Status) :-
	compile_body(Body,BodyCode,Status),
	( Status == [] ->
	    thismodule_struct(ThisMod),
	    caller_binding_code(ThisMod,CallerBindingCode),
	    conjunct_struct(CallerBindingCode,BodyCode,AugmentedBodyCode),
	    collect_namevars(Body,NV),
	    list_struct(NV,[],NVCode),
	    florasyslib_struct(FLLIBANSWER,2,[AugmentedBodyCode,NVCode],Goal),
	    query_struct(Goal,QueryCode),
            get_directive(DirectCodeList),
	    append(DirectCodeList,[QueryCode|ListTail],CodeList)
	;
	  true
	).



/***************************************************************************
  Compile the export directive
  The body can be a list of export terms, which are compiled individually.
***************************************************************************/
compile_export(BodyTerm,Code) :-
	compile_export_predicate_list(BodyTerm,BodyTermCode),
	list_struct(BodyTermCode,[],BodyTermCodeList),
	export_struct(BodyTermCodeList,Code).


/****************************************************************************
  compile_export_predicate_list(+List,-Code)
  To recursively compile a list of export predicates.
****************************************************************************/
compile_export_predicate_list([H|T],Code) :-
	compile_export_predicate(H,HCode,_Status),
	compile_export_predicate_list(T,TCode),
	append([HCode],TCode,Code).
	
compile_export_predicate_list([],[]) :- !.


/****************************************************************************
  compile_export_predicate(+ExportTerm,-Code,-Status)
****************************************************************************/
compile_export_predicate(ExportTerm,Code,Status) :-
	(
	  is_flexport(ExportTerm,BodyTerm,ModuleList,IsUpdatable)
	;
	  is_flexport(ExportTerm,WS,BodyTerm,ModuleList,IsUpdatable)
	),
	is_flfact(BodyTerm,ParseBodyTerm),
	%% compile_fact expects the argument to be a list.
	%% Hence the ParseBodyTerm is enclosed in a list.
	%%if they are uninitialized, they will be taken care at run-time.
	compile_fact([ParseBodyTerm],ListBodyTermCode,_StatusFact),
	compile_pathexp(ModuleList,ModuleListCode,_,_,_StatusModule),
	compile_pathexp(IsUpdatable,IsUpdatableCode,_,_,_Status),
	(
		var(WS) -> 
			true
		;
			compile_pathexp(WS,WSCode,_,_,Status)
	),
	%% It may be the case that the predicate itself is a comma separated list
	%% Convert ListBodyTermCode from a difference list to a normal list
	%% then wrap each element of the list in PREXPORT
	compile_export_list_convert(ListBodyTermCode,WSCode,ModuleListCode,IsUpdatableCode,Code).


/****************************************************************************
  compile_export_list_convert(+Args,-Code)
   Args is a difference list of the form : [H|_V] -_V.
   Ground _V to [] and convert the diff list to a list
   Then processes the list with compile_export_extract_facts
****************************************************************************/
compile_export_list_convert(ListBodyTermCode - T, WSCode, ModuleListCode,IsUpdatableCode,Code) :-
	T = [],
	%% ListBodyTermCode is a list of facts; process them
	compile_export_extract_facts(ListBodyTermCode,[],WSCode,ModuleListCode,IsUpdatableCode,Code).


/****************************************************************************
  compile_export_extract_facts(+Args,+InitialTerm,+WSCode,+ModuleListCode,+IsUpdatableCode,-Code)
  Encloses the individual predicates of the Args list in a PREXPORT struct. 
  Then the whole list is compiled as a list_struct.
****************************************************************************/
compile_export_extract_facts([H|T],InitTerm,WSCode,ModuleListCode,IsUpdatableCode,Code) :-
	is_prfact(H,HTermCode),
	construct_export_struct(HTermCode,WSCode,IsUpdatableCode,ModuleListCode,HCode),
	compile_export_extract_facts(T,[HCode|InitTerm],WSCode,ModuleListCode,IsUpdatableCode,Code).

compile_export_extract_facts([],InitTerm,_WSCode,_ModuleListCode,_IsUpdatableCode,Code) :-
	list_struct(InitTerm,[],Code).


/****************************************************************************
  construct_export_struct(+Term,+WSCode,+IsUpdatableCode,+ModuleListCode,-Code)
  Constructs an appropriate prexport struct.
****************************************************************************/
construct_export_struct(TermCode,WSCode,IsUpdatableCode,ModuleListCode,Code) :-
	thismodule_struct(ThisModule),
	atomobj_struct(FLEXPORT,FCode),
	( var(WSCode) ->
		prologterm_struct(FCode,4,[IsUpdatableCode,ThisModule,ModuleListCode,TermCode],Code)
	;
		prologterm_struct(FCode,5,[WSCode,IsUpdatableCode,ThisModule,ModuleListCode,TermCode],Code)
	).


/****************************************************************************
  compile_rule(+Head,+Body,-CodeDiffList,-Status)

  CodeDiffList is a difference list in the form of [...|T]-T. It is for
  the optimization of append.
****************************************************************************/
compile_rule(Head,Body,CodeList-ListTail,Status) :-
	compile_head(Head,HeadCode,HS),
	compile_conjunct2list(HeadCode,HeadCodeList),
	( HS == [] ->
	    compile_body(Body,BodyCode,BS),
	    ( BS == [] ->
		get_directive(DirectCodeList),
		append(DirectCodeList,T,CodeList),
		compile_rulelist(HeadCodeList,BodyCode,T-ListTail),
		check_vars(Head,Body,Status)
	    ;
	        Status=BS
	    )
	;
	  Status=HS
        ).

/****************************************************************************
  compile_rulelist(+HeadCodeList,+BodyCode,-CodeDiffList)

  HeadCodeList is a list of atoms in the rule head. BodyCode is the formula
  in the rule body. This procedure splits the list of atoms in the rule
  head and generates a difference list.
****************************************************************************/
/* uncomment to turn on clause{...} for static rules
compile_rulelist([H],Body,[InsSigCode,Code|T]-T) :-
*/
compile_rulelist([H],Body,[Code|T]-T) :-  %% remove this line to turn on clause{...} for static rules 
	!,
	%% Only a single atom appears in the rule head.
/* uncomment to turn on clause{...} for static rules
        insert_rule_signature_struct(H,Body,InsSigCode),
*/
	rule_struct(H,Body,Code).

/* uncomment to turn on clause{...} for static rules
compile_rulelist(HeadList,Body,[InsSigCode,Code|CodeList]-ListTail) :-
*/
compile_rulelist(HeadList,Body,[Code|CodeList]-ListTail) :-  %% remove this line to turn on clause{...} for static rules 
	%% Multiple atoms appear in the rule head.
	%% Generate a temp rule.
	allvars(HeadList,HeadVars),
	length(HeadVars,N),
	new_predicate(Name),
	callermod_info_structure(CallerVarObj),
	append(HeadVars,[CallerVarObj],HeadVarsAndCaller),
	N1 is N+1,
	newpredicate_struct(Name,N1,HeadVarsAndCaller,Newpredicate),
/* uncomment to turn on clause{...} for static rules
        insert_rule_signature_struct(HeadList,Body,Newpredicate,InsSigCode),
*/
	rule_struct(Newpredicate,Body,Code),
	%% Split the atoms over this temp rule.
	rule_difflist(HeadList,Newpredicate,CodeList-ListTail).


rule_difflist([],_B,CodeList-CodeList) :- !.

rule_difflist([H|L],B,[HC|LC]-T) :-
	rule_struct(H,B,HC),
	rule_difflist(L,B,LC-T).

/* uncomment to turn on clause{...} for static rules
insert_rule_signature_struct(Head,Body,Code) :-
        insert_rulesig_struct(Head,Body,NULL,CCode),
        query_struct(CCode,Code).

insert_rule_signature_struct(HeadList,Body,Newpred,Code) :-
        list_struct(HeadList,[],HeadListCode),
        insert_rulesig_struct(HeadListCode,Body,Newpred,CCode),
        query_struct(CCode,Code).
*/

/****************************************************************************
  compile_conjunct2list(+ConjunctCode,-CodeList)
  compile_conjunct2list(+ConjunctCode,-CodeList,-ListTail)

  ConjunctCode may contain NULL.
****************************************************************************/
compile_conjunct2list(ConjunctCode,CodeList) :-
	compile_conjunct2list(ConjunctCode,CodeList,[]).


compile_conjunct2list(NULL,CodeList,CodeList) :- !.

compile_conjunct2list(ConjunctCode,CodeList,ListTail) :-
	conjunct_struct(C1,C2,ConjunctCode),
	!,
	compile_conjunct2list(C1,CodeList,T1),
	compile_conjunct2list(C2,T1,ListTail).

compile_conjunct2list(Code,[Code|ListTail],ListTail) :- !.


/****************************************************************************
  compile_head(+ParserTermList,-Code,-Status)
****************************************************************************/
compile_head([],NULL,[]) :- !.

compile_head([ParserTerm|ParserTermList],Code,Status) :-
	compile_head_literal(ParserTerm,PCode,S),
	( S == [] ->
	    compile_head(ParserTermList,PLCode,Status),
	    (Status == [] -> conjunct_struct(PCode,PLCode,Code); true)
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_literal(+ParserTerm,-Code,-Status)

  Code is conjunction of atoms, which should be split into a list later.
****************************************************************************/
compile_head_literal(ParserTerm,Code,Status) :-
	( is_flterm(ParserTerm,Funct,1,[Arg]),
            is_flatom(Funct,FL_TRAN,TranInd),
            is_flvar(Arg,AName,AIndex) ->
	    %% #X translated into #X@_@
            atomobj_struct(Funct,FObj),
            compile_flvar(AName,AIndex,AObj),
	    termlit_struct(BODYLITERAL,FObj,1,[AObj],V),
            thismodule_struct(ThisModule),
	    callerargsterm_struct(ThisModule,CallerInfo),
            florasyslib_struct(TranInd,FLLIBMODLIT,3,[V,ThisModule,CallerInfo], Code),
            Status=[]

	; is_flvar(ParserTerm,VName,VIndex) ->
	    %% X translated into X@_@
            compile_flvar(VName,VIndex,V),
            ( COMPILATION_CONTEXT(compile_with_var_module) ->
            %% By default COMPILATION_CONTEXT(compile_with_var_module)
	    %% is false, unless
            %% it has been asserted by compiling constructs that require
            %% variable literals in head to be kept as variables, including 
            %% reification as an object and ~
                Code=V
            ;
	        %% X translated into the call X@_@
                thismodule_struct(ThisModule),
		callerargsterm_struct(ThisModule,CallerInfo),
                florasyslib_struct(VIndex,FLLIBMODLIT,3,[V,ThisModule,CallerInfo], Code)
            ),
	    Status=[]

	; is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_head_fltermlit(Funct,N,Args,Code,Status)

	; is_flbirelate(ParserTerm,OT1,RelType,OT2) ->
	    compile_head_flbirelate(OT1,RelType,OT2,_Obj,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_head_flobjspec(ObjTerm,Spec,_Obj,Code,Status)

	; is_flobjeql(ParserTerm,Obj1,Obj2) ->
	    compile_head_flobjeql(Obj1,Obj2,Code,Status)

	; is_flworkspace(ParserTerm,P,WS) ->
	    compile_head_wsliteral(P,WS,Code,Status)

	; is_flfloralib(ParserTerm,P,Module) ->
	    compile_head_floraliblit(P,Module,Code,Status)

        ; is_flvar(ParserTerm,_Name,Index) ->
            varobj_struct(ParserTerm,V),
            thismodule_struct(ThisModule),
	    callerargsterm_struct(ThisModule,CallerInfo),
            florasyslib_struct(Index,FLLIBMODLIT,3,[V,ThisModule,CallerInfo],Code),
	    Status=[]
	;
	    %% atom (0-ary predicate)
	    atomlit_struct(HEADLITERAL,ParserTerm,Code),
	    Status=[]
	).


/****************************************************************************
  compile_body(+ParserTerm,-Code,-Status)
****************************************************************************/
compile_body(ParserTerm,Code,Status) :-
	is_flconjunct(ParserTerm,L,R),
	!,
	compile_body(L,LCode,S),
	( S == [] ->
	    compile_body(R,RCode,Status),
	    (Status == [] -> conjunct_struct(LCode,RCode,Code); true)
	;
	  Status=S
        ).

compile_body(ParserTerm,Code,Status) :-
	is_fldisjunct(ParserTerm,L,R),
	!,
	compile_body(L,LCode,S),
	( S == [] ->
	    compile_body(R,RCode,Status),
	    (Status == [] -> disjunct_struct(LCode,RCode,Code); true)
	;
	  Status=S
        ).

compile_body(ParserTerm,Code,Status) :-
	is_flnot(ParserTerm,G),
	!,
	compile_body(G,GCode,Status),
	(Status == [] -> not_struct(GCode,Code); true).

compile_body(ParserTerm,Code,Status) :-
	is_fltnot(ParserTerm,G),
	!,
	compile_body(G,GCode,Status),
	(Status == [] -> tnot_struct(GCode,Code); true).

compile_body(ParserTerm,Code,Status) :-
        compile_body_literal(ParserTerm,Code,Status).


/****************************************************************************
  compile_body_literal(+ParserTerm,-Code,-Status)
****************************************************************************/
compile_body_literal(ParserTerm,Code,Status) :-
	( is_flterm(ParserTerm,Funct,1,[Arg]),
            is_flatom(Funct,FL_TRAN,TranInd),
            is_flvar(Arg,AName,AIndex) ->
	    %% #X translated into #X@_@
            atomobj_struct(Funct,FObj),
            compile_flvar(AName,AIndex,AObj),
	    termlit_struct(BODYLITERAL,FObj,1,[AObj],V),
            thismodule_struct(ThisModule),
	    callerargsterm_struct(ThisModule,CallerInfo),
            florasyslib_struct(TranInd,FLLIBMODLIT,3,[V,ThisModule,CallerInfo], SpecCode),
            OidCode=NULL,
            Status=[]

	; is_flvar(ParserTerm,VName,VIndex) ->
            compile_flvar(VName,VIndex,V),
            ( COMPILATION_CONTEXT(compile_with_var_module) ->
            %% By default COMPILATION_CONTEXT(compile_with_var_module)
	    %% is false, unless
            %% it has been asserted by compiling constructs that require
            %% variable literals in the body to be kept as variables, including
            %% reification as an object, ~ , and clause
                SpecCode=V
            ;
	        %% X translated into the call X@_@
                thismodule_struct(ThisModule),
		callerargsterm_struct(ThisModule,CallerInfo),
                florasyslib_struct(VIndex,FLLIBMODLIT,3,[V,ThisModule,CallerInfo], SpecCode)
            ),
	    OidCode=NULL,
	    Status=[]

        ; is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_fltermlit(Funct,N,Args,OidCode,SpecCode,Status)

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    compile_flbirelate(ObjTerm1,RelType,ObjTerm2,_Obj,OidCode,SpecCode,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_flobjspec(ObjTerm,Spec,_Object,OidCode,SpecCode,Status)

	; is_flload(ParserTerm,LoadList) ->
	    compile_flload(LoadList,SpecCode,Status),
	    OidCode=NULL

	; is_flconstraint(ParserTerm,ConstrBody) ->
	    compile_body(ConstrBody,ConstrBodyCode,Status),
	    constraint_struct(ConstrBodyCode,SpecCode),
	    OidCode=NULL

	; is_flworkspace(ParserTerm,P,WS) ->
	    compile_wsliteral(P,WS,OidCode,SpecCode,Status)

	; is_flplib(ParserTerm,P) ->
	    compile_prologliblit(P,OidCode,SpecCode,Status)
	; is_flplib(ParserTerm,P,Module) ->
	    compile_prologliblit(P,Module,OidCode,SpecCode,Status)

	; is_flpliball(ParserTerm,P) ->
	    compile_prologallliblit(P,OidCode,SpecCode,Status)
	; is_flpliball(ParserTerm,P,Module) ->
	    compile_prologallliblit(P,Module,OidCode,SpecCode,Status)

	; is_flfloralib(ParserTerm,P,Module) ->
	    compile_floraliblit(P,Module,OidCode,SpecCode,Status)

	; is_flinsert(ParserTerm,Op,List,Cond) ->
	    compile_flinsert(Op,List,Cond,SpecCode,Status),
	    OidCode=NULL

	; is_flinsert(ParserTerm,Op,List) ->
	    compile_flinsert(Op,List,SpecCode,Status),
	    OidCode=NULL

	; is_fldelete(ParserTerm,Op,List,Cond) ->
	    compile_fldelete(Op,List,Cond,SpecCode,Status),
	    OidCode=NULL

	; is_fldelete(ParserTerm,Op,List) ->
	    compile_fldelete(Op,List,SpecCode,Status),
	    OidCode=NULL

	%% Rule: can occur inside reify_op
	; ParserTerm = [ReifiedRule|_],
	    is_fldynrule(ReifiedRule,_H,_B) ->
	    compile_reifyop(ParserTerm,SpecCode,OidCode,Status)

	%% Rule: can occur inside reify_op
	; ParserTerm = [ReifiedRule|_],
	    is_flruleworkspace(ReifiedRule,_RealRule,_WS) ->
	    compile_reifyop(ParserTerm,SpecCode,OidCode,Status)

	; is_fltablerefresh(ParserTerm,List) ->
	    compile_flrefresh(List,SpecCode,Status),
	    OidCode=NULL

	; is_flcatch(ParserTerm,Goal,Error,Handler) ->
	    compile_flcatch(Goal,Error,Handler,SpecCode,Status),
	    OidCode=NULL

	; is_flthrow(ParserTerm,Error) ->
	    compile_flthrow(Error,SpecCode,Status),
	    OidCode=NULL

	; is_flp2h(ParserTerm,Prolog,Hilog) ->
	    compile_flp2h(Prolog,Hilog,SpecCode,Status),
	    OidCode=NULL

	; is_flnewoidop(ParserTerm,VarTerm) ->
	    is_flvar(VarTerm,Name,Index),
	    compile_flvar(Name,Index,VarCode),
	    newoidop_struct(VarCode,SpecCode),
	    Status = [],
	    OidCode=NULL

	; is_flnewmodule(ParserTerm,Op,Module) ->
	    is_flatom(Op,_OpAtom,Index),
	    compile_flatomvar(Module,ModCode),
	    thismodule_struct(ThisModuleName),
	    florasyslib_struct(Index,FLLIBNEWMODULE,2,[ThisModuleName,ModCode],SpecCode),
	    Status=[],
	    OidCode=NULL

	; is_flcallermodule(ParserTerm,Op,Module) ->
	    is_flatom(Op,_OpAtom,Index),
	    compile_flatomvar(Module,ModCode),
	    caller_binding_code(ModCode,SpecCode),
	    Status=[],
	    OidCode=NULL

	; is_flupdaterule(ParserTerm,Op,List) ->
	    compile_flupdaterule(Op,List,SpecCode,Status),
	    OidCode=NULL
		
        ; is_flclause(ParserTerm,Head,Body) ->
            compile_flclause(NULL,Head,Body,SpecCode,Status),
            OidCode=NULL

        ; is_flclause(ParserTerm,Mode,Head,Body) ->
            compile_flclause(Mode,Head,Body,SpecCode,Status),
            OidCode=NULL

	; is_flifthenelse(ParserTerm,Cond,Then,Else) ->
	    compile_flifthenelse(Cond,Then,Else,SpecCode,Status),
	    OidCode=NULL

	; is_flifthen(ParserTerm,Cond,Then) ->
	    compile_flifthen(Cond,Then,SpecCode,Status),
	    OidCode=NULL

	; is_fluniveqform(ParserTerm,Left,Right) ->
	    compile_fluniveqform(Left,Right,SpecCode,Status),
	    OidCode=NULL

	; is_flmetauniv(ParserTerm,Left,Right) ->
	    compile_flmetauniv(Left,Right,OidCode,SpecCode,Status)
	
	; is_flmetaunivform(ParserTerm,Left,Right) ->
	    compile_flmetaunivform(Left,Right,OidCode,SpecCode,Status)

	; is_flcontrolconstruct(ParserTerm,Wrapper,Cond,Action) ->
	    compile_flcontrolconstruct(Cond,Action,Wrapper,SpecCode,Status),
	    OidCode = NULL
	
	; is_flcut(ParserTerm,I) ->
	    cut_struct(I,SpecCode),
	    OidCode=NULL,
	    Status=[]

	; is_flatom(ParserTerm,_A) ->
	    atomlit_struct(BODYLITERAL,ParserTerm,SpecCode) ->
	    OidCode=NULL,
	    Status=[]

	; is_flobjeql(ParserTerm,O1,O2) ->
	    compile_flobjeql(O1,O2,OidCode,SpecCode,Status)

	; is_fldirective(ParserTerm,DirectList,_Idx) ->
	    compile_exec_directive(DirectList,NULL,SpecCode,Status),
	    OidCode=NULL
	),
	conjunct_code([OidCode,SpecCode],Code).


/****************************************************************************
  compile_flifthenelse(+Cond,+Then,+Else,-Code,-Status)
****************************************************************************/
compile_flifthenelse(Cond,Then,Else,Code,Status) :-
	compile_body(Cond,CondCode,S1),
	( S1 == [] ->
	    compile_body(Then,ThenCode,S2),
	    ( S2 == [] ->
		compile_body(Else,ElseCode,Status),
		(Status == [] -> ifthenelse_struct(CondCode,ThenCode,ElseCode,Code); true)
	    ;
	      Status=S2
	    )
	;
	  Status=S1
	).


/****************************************************************************
  compile_flifthen(+Cond,+Then,-Code,-Status)
****************************************************************************/
compile_flifthen(Cond,Then,Code,Status) :-
	compile_body(Cond,CondCode,S1),
	( S1 == [] ->
	    compile_body(Then,ThenCode,Status),
	    (Status == [] -> ifthen_struct(CondCode,ThenCode,Code); true)
	;
	  Status=S1
	).

/****************************************************************************
  compile_fluniveqform(+Left,+Right,-Code,-Status)

  Compiling ~
  This produces only spec code -- no oid code, because each argument
  is treated as Meta, so no oid is passed utside of this term
****************************************************************************/
compile_fluniveqform(Left,Right,Code,Status) :-
        set_context(compile_with_var_module),
	compile_body(Left,LeftCode,S1),
	( S1 == [] ->
	    compile_body(Right,RightCode,Status),
	    (Status == [] -> univeqform_struct(LeftCode,RightCode,Code); true)
	;
	  Status=S1
	),
        clear_context(compile_with_var_module).


/****************************************************************************
  compile_flmetauniv(+Left,+Right,-OidCode,-Code,-Status)
  Compiling =..
****************************************************************************/
compile_flmetauniv(Left,Right,OidCode,Code,Status) :-
	%% Use pathexp translation instead of body translation, because we
	%% don't want module name to be tacked on unless requested
	%% LeftCode becomes bound to the OID code of Left
	%% ObjCode is later conjuncted with the result
	compile_pathexp(Left,LeftCode,OidCodeLeft,ObjCode,S1),
	( S1 == []
	-> compile_pathexp(Right,RightCode,OidCodeRight,RightObjCode,Status),
	    (Status == []
	    -> metauniv_struct(LeftCode,RightCode,UnivCode),
		conjunct_code([UnivCode,ObjCode,RightObjCode],Code),
		conjunct_code([OidCodeLeft,OidCodeRight],OidCode)
	    ; true
	    )
	;
	    Status=S1
	).



/****************************************************************************
  compile_flmetaunivform(+Left,+Right,-OidCode,-Code,-Status)
  Compiling ~..
****************************************************************************/
compile_flmetaunivform(Left,Right,OidCode,Code,Status) :-
        set_context(compile_with_var_module),
	compile_body(Left,LeftCode,S1),
        clear_context(compile_with_var_module),
	( S1 == []
	-> compile_pathexp(Right,RightCode,OidCode,RightObjCode,Status),
	    (Status == []
	    -> metauniv_struct(LeftCode,RightCode,UnivCode),
		conjunct_code([UnivCode,RightObjCode],Code)
	    ; true
	    )
	; Status=S1
	).



/****************************************************************************
  compile_flcontrolconstruct(+Cond,+Action,+Wrapper,-Code,-Status)

  Handle control stmts while-do,do-until,while-loop,loop-until,unless-do
****************************************************************************/
compile_flcontrolconstruct(Cond,Action,Wrapper,Code,Status) :-
	compile_body(Cond,CondCode,S1),
	(S1 == []
	-> compile_body(Action,ActionCode,Status),
	    (Status==[]
	    -> controlconstruct_struct(CondCode,ActionCode,Wrapper,Code)
	    ; true
	    )
	; Status = S1
	).


/****************************************************************************
  compile_pathexp(+ParserTerm,-Object,-OidCode,-Code,-Status)

  Handles pathexps that are atoms, numbers, special tokens, like _#, _#123, _@,
  vars, strings
****************************************************************************/
%% ParserTerm is a primitive object -- no oid code and no spec code results
compile_pathexp(ParserTerm,Object,NULL,NULL,[]) :-
	( is_flatom(ParserTerm,_A) ->
	    atomobj_struct(ParserTerm,Object)

	; is_fltoken(ParserTerm,FL_THISMODULE,_Index) ->
	    thismodule_struct(Object)

	%% Anonymous OIDs can appear in the "body": they can appear
	%% in reified formulas, which are compiled as body literals
	; is_fltoken(ParserTerm,FL_NEWOID,Index) ->
	    new_oidobj(Index,Object)

	%% A numbered OID, which appears in a reified formula in rule body
	; is_fltoken(ParserTerm,FL_NEWOID,Num,Index) ->
	    flora_get_counter(RULE_NUM, Rule_num), 
	    new_oidobj(Rule_num,Num,Index,Object)

	; is_flnumber(ParserTerm,_N) ->
	    numobj_struct(ParserTerm,Object)

	; is_flvar(ParserTerm,Name,Index) ->
	    compile_flvar(Name,Index,Object)

	; is_flstring(ParserTerm,_S) ->
	    strobj_struct(ParserTerm,Object)
	),
	!.

compile_pathexp(ParserTerm,Object,OidCode,Code,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_fltermobj(Funct,N,Args,Object,OidCode,Code,Status)

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    compile_flbirelate(ObjTerm1,RelType,ObjTerm2,Object,OidCode,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_flobjspec(ObjTerm,Spec,Object,OidCode,Code,Status)

	; is_flobjref(ParserTerm,ObjTerm,RefType,AttTerm) ->
	    compile_flobjref(ObjTerm,RefType,AttTerm,Object,OidCode,Code,Status)

	; is_fllist(ParserTerm,L,T,I) ->
	    compile_fllist(L,T,I,Object,OidCode,Code,Status)

	; is_flaggregate(ParserTerm,Op,V,GV,B) ->
	    %% Aggregates are treated as OID, so its code would come
	    %% ahead of the code of the literal it occurs in
	    compile_flaggregate(Op,V,GV,B,Object,OidCode,Status)

	; is_reifyop(ParserTerm,Formula) ->
            set_context(compile_with_var_module),
	    compile_reifyop(Formula,Object,OidCode,Status),
            clear_context(compile_with_var_module),
	    Code=NULL

	; is_flplib(ParserTerm,P) ->
	    compile_prologlibobj(P,Object,OidCode,Code,Status)
	; is_flplib(ParserTerm,P,Module) ->
	    compile_prologlibobj(P,Module,Object,OidCode,Code,Status)

	; is_flpliball(ParserTerm,P) ->
	    compile_prologalllibobj(P,Object,OidCode,Code,Status)
	; is_flpliball(ParserTerm,P,Module) ->
	    compile_prologalllibobj(P,Module,Object,OidCode,Code,Status)
	
	; is_flfloralib(ParserTerm,P,Module) ->
	    compile_floralibobj(P,Module,Object,OidCode,Code,Status)
	;
	  is_flworkspace(ParserTerm,P,WS),
	  compile_wspathexp(P,WS,Object,OidCode,Code,Status)
	).


/****************************************************************************
  compile_pathexplist(+ParserTermList,-ObjectList,-OidCode,-Code,-Status)
****************************************************************************/
compile_pathexplist([],[],NULL,NULL,[]) :- !.

compile_pathexplist([T|L],[TObj|LObj],OidCode,Code,Status) :-
	compile_pathexp(T,TObj,OidCodeHead,TCode,S),
	( S == [] ->
	    compile_pathexplist(L,LObj,OidCodeTail,LCode,Status),
	    (Status == [] ->
		conjunct_code([TCode,LCode],Code),
		conjunct_code([OidCodeHead,OidCodeTail],OidCode)
	    ;
		true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_argpathexplist(+ParserTermList,+ArgTypeList,
                         -ObjectList,-OidCode,-Code,-Status)
  NOTE: This functionality is not exposed to the user.
        Exists for findall, call, and get_residual (see flrarguments.P)
****************************************************************************/
compile_argpathexplist([],[],[],NULL,NULL,[]).

compile_argpathexplist([T|L],[FL_OID|ArgTypeList],[TObj|LObj],OidCode,Code,Status) :-
	!,
	compile_pathexp(T,TObj,OidCodeHead,TCode,S),
	( S == [] ->
	    compile_argpathexplist(L,ArgTypeList,LObj,OidCodeTail,LCode,Status),
	    (Status == [] ->
		conjunct_code([TCode,LCode],Code),
		conjunct_code([OidCodeHead,OidCodeTail],OidCode)
	    ; true
	    )
	;
	  Status=S
        ).

compile_argpathexplist([T|L],[FL_BODYFORMULA|ArgTypeList],[TCode|LObj],OidCode,Code,Status) :-
	!,
	%% because we are compiling a meta here, the code
	%% is self-contained -- no oid part will be pushed
	%% to the front of the enveloping term
	%%compile_body(T,TCode,S),
	set_context(goal_reification),
	compile_body(T,TCode1,S),
	reify_struct(TCode1,TCode),
	clear_context(goal_reification),
	( S == [] ->
	    compile_argpathexplist(L,ArgTypeList,LObj,OidCode,Code,Status)
	;
	  Status=S
        ).


/****************************************************************************
  compile_flload(+LoadList,-Code,-Status)
****************************************************************************/
compile_flload(LoadList,Code,Status) :-
	is_fllist(LoadList,L,T,I),
	%% since complex terms aren't allowed in load lists, we ignore OidCode
	compile_fllist(L,T,I,ObjList,_OidCode,OCode,Status),
	( Status == [] ->
	    thismodule_struct(Mod),
	    %% This is the file being compiled
	    (flora_compiler_environment(file,ProgramFile), !
	    ; ProgramFile=userin
	    ),
	    %% "I" is a token index
	    flora_nth_token(I,Token),
	    flora_token_text(Token,_TextStr,BLN,BCN,_ELN,_ECN),
	    %% Encode location of the literal [file>>mod]
	    %% Location is used for error checking in flrload.P to make sure
	    %% that loading of a file doesn't override the program
	    %% in which the loading statement occurs
	    list_struct([BLN,BCN],[],PositionCode),
	    florasyslib_struct(I,FLLIBLOAD,
			       4,
			       [ObjList,ProgramFile,Mod,PositionCode],LCode),
	    conjunct_code([OCode,LCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_flvar(+Name,+Index,-VarObject)
****************************************************************************/
compile_flvar(Name,Index,VarObject) :-
	( Name == FL_UNDERSCORE ->
	    new_varobj(Index,VarObject)
	;
	  varobj_struct(Name,Index,VarObject)
        ).


/****************************************************************************
  compile_fltermobj(+FunctorTerm,+Arity,+ArgList,-Object,-OidCode,-Code,-Status)

  Compile term in the OID position.
****************************************************************************/
compile_fltermobj(Funct,N,Args,Object,OidCode,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_argpathexplist(Args,ArgTypes,AObj,OidCode,Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).

compile_fltermobj(Funct,N,Args,Object,OidCode,Code,Status) :-
	compile_pathexplist([Funct|Args],[FObj|AObj],OidCode,Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).


/****************************************************************************
  compile_fltermlit(+FunctorTerm,+Arity,+ArgList,-OidCode,-Code,-Status)

  Compile term in a predicate position in rule body.
****************************************************************************/
compile_fltermlit(Funct,N,Args,OidCode,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_argpathexplist(Args,ArgTypes,AObj,OidCode,ObjCode,Status),
	( Status == [] ->
	    termlit_struct(BODYLITERAL,FObj,N,AObj,TCode),
	    conjunct_code([TCode,ObjCode],Code)
	;
	  true
        ).

compile_fltermlit(Funct,N,Args,OidCode,Code,Status) :-
	compile_pathexplist([Funct|Args],[FObj|AObj],OidCode,ObjCode,Status),
	( Status == [] ->
	    termlit_struct(BODYLITERAL,FObj,N,AObj,TCode),
	    conjunct_code([TCode,ObjCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_fllist(+ObjTermList,+ObjTerm,+Index,-Object,-OidCode,-Code,-Status)

  Index refers to '['.
  Lists are like this: [a,b,c|rest]
  ObjTermList refers to the list [a,b,c] and ObjTerm to rest.
****************************************************************************/
compile_fllist(ObjTermList,ObjTerm,Index,Object,OidCode,Code,Status) :-
	compile_pathexplist(ObjTermList,ObjList,OidCodeList,ObjListCode,S),
	( S == [] ->
	    ( ObjTerm == [] ->
		Obj=[],
		OidCodeObj=NULL,
		ObjCode=NULL,
		Status=[]
	    ;
	      compile_pathexp(ObjTerm,Obj,OidCodeObj,ObjCode,Status)
	    ),
	    ( Status == [] ->
		list_struct(ObjList,Obj,Index,Object),
		conjunct_code([ObjListCode,ObjCode],Code),
		conjunct_code([OidCodeList,OidCodeObj],OidCode)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_flobjref(+ObjTerm,+RefType,+AttTerm,-Object,-OidCode,-Code,-Status)

  Process an object reference like a.b.c
  An objref can be more complex, e.g., a[f->g].b[h->>p].c[k->u]
****************************************************************************/
compile_flobjref(ObjTerm,RefType,AttTerm,Object,OidCode,Code,Status) :-
	compile_pathexplist([ObjTerm,AttTerm],[Obj,Att],OidCodeList,OCode,Status),
	( Status == [] ->
	    %% Approximate the textual information for the new variable.
	    approximate_index(AttTerm,Index),
	    body_objref_struct(Obj,RefType,Att,Index,Object,TCode),
	    Code = OCode,
	    conjunct_code([OidCodeList,TCode],OidCode)
	;
	  true
        ).


/****************************************************************************
  compile_flbirelate(+ObjTerm1,+RelType,+ObjTerm2,-Object,-Code,-Status)

  Compiles binary relationships, like : or ::.
****************************************************************************/
compile_flbirelate(ObjTerm1,RelType,ObjTerm2,Obj1,OidCode,Code,Status) :-
	compile_pathexplist([ObjTerm1,ObjTerm2],[Obj1,Obj2],OidCode,OCode,Status),
	( Status == [] ->
	    birelate_struct(BODYLITERAL,Obj1,RelType,Obj2,TCode),
	    conjunct_code([TCode,OCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_flobjspec(+ObjTerm,+SpecBody,-Object,-OidCode,-Code,-Status)

  Code produced by this and similar predicates is divided into
  OidCode and Code. 
  OidCode is the code needed to compute the attribute of molecule
  and the oid, and the oid of the value part (in ->, ->>, etc.)
  Code represents the code needed to compute the the attribute specification.
  For instance, in  a.b[c.d->e.f],
      OidCode will represent the computation of c.d and e.d:
	 prand(prfd(a,b,_newvar1),prand(prfd(c,d,_newvar2),prfd(e,d,_newvar3)))
      Code will represent the -> part:
                 prfd(_newvar1,_newvar2,_newvar3)
****************************************************************************/
compile_flobjspec(ObjTerm,SpecBody,Object,OidCode,Code,Status) :-
	( SpecBody == [] ->
	    %% Just objref, no body. Something like a.b.c. Possibly a.b.c[]
	    ( is_flobjref(ObjTerm,OTerm,RefType,ATerm) ->
		compile_pathexplist([OTerm,ATerm],[OObj,AObj],OidCode,ObjCode,Status),
		( Status == [] ->
		    approximate_index(ATerm,Index),
		    body_objref_struct(OObj,RefType,AObj,Index,Object,TCode),
		    conjunct_code([TCode,ObjCode],Code)
		;
		  true
	        )
	    ;
	      compile_pathexp(ObjTerm,Object,OidCode,ObjCode,Status),
	      ( Status == [] ->
		  objexists_struct(BODYLITERAL,Object,ECode),
		  conjunct_code([ECode,ObjCode],Code)
	      ;
	        true
	      )
	    )
	; % oid spec plus object spec. something like a.b[c->d]
	    compile_pathexp(ObjTerm,Object,ObjOidCode,ObjCode,S),
	    ( S == []
	    -> compile_flspecbody(Object,SpecBody,SpecOidCode,SpecCode,Status),
		(Status == [] ->
		    conjunct_code([ObjCode,SpecCode],Code),
		    conjunct_code([ObjOidCode,SpecOidCode],OidCode)
		; true
		)
	    ;
		Status=S
	    )
        ).

/****************************************************************************
  compile_flspecbody(+Object,+SpecTerm,-OidCode,-Code,-Status)

   Compile the specification part of a molecule Object[SpecTerm]
   Object: describes the oid
   SpecTerm: descripes the specification inside the brackets
   Code: the resulting compiled code
****************************************************************************/
compile_flspecbody(Object,SpecTerm,OidCode,Code,Status) :-
	is_flconjunct(SpecTerm,L,R),
	!,
	compile_flspecbody(Object,L,OidCode,LCode,S),
	( S == [] ->
	    compile_flspecbody(Object,R,OidCode,RCode,Status),
	    (Status == [] -> conjunct_code([LCode,RCode],Code); true)
	;
	  Status=S
        ).

compile_flspecbody(Object,SpecTerm,OidCode,Code,Status) :-
	is_fldisjunct(SpecTerm,L,R),
	!,
	compile_flspecbody(Object,L,OidCode,LCode,S),
	( S == [] ->
	    compile_flspecbody(Object,R,OidCode,RCode,Status),
	    (Status == [] -> disjunct_struct(LCode,RCode,Code); true)
	;
	  Status=S
        ).

compile_flspecbody(Object,SpecTerm,OidCode,Code,Status) :-
	is_flnot(SpecTerm,G),
	!,
	compile_flspecbody(Object,G,OidCode,GCode,Status),
	(Status == [] ->
	    conjunct_code([OidCode,GCode],CombinedGCode),
	    not_struct(CombinedGCode,Code)
	; true
	).

compile_flspecbody(Object,SpecTerm,OidCode,Code,Status) :-
	is_fltnot(SpecTerm,G),
	!,
	compile_flspecbody(Object,G,OidCode,GCode,Status),
	(Status == [] ->
	    conjunct_code([OidCode,GCode],CombinedGCode),
	    tnot_struct(CombinedGCode,Code)
	; true
	).

%% F-molecule with attribute specification.
%% Can be O[M->V], where O,M,V can be any complex F-molecule
%% OidCodeList below gets bound to code needed to produce
%% the attribute (M) and the value (V). We conjunct this code in front of the
%% code for the molecule
%% NULL means that we don't pass OID code out, because we use it right here.
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_flfdattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_pathexplist([AttTerm,ValTerm],[AttObj,ValObj],OidCode,OCode,Status),
	( Status == [] ->
	    fdattspec_struct(BODYLITERAL,Object,AttObj,RefType,ValObj,SCode),
	    %% SCode: code to produce object reference, attribute, and value
	    %% OCode: code for the pure attribute spec of the object
	    %% OidCode: code to produce the attribute and the value
	    conjunct_code([OidCode,SCode,OCode],Code)
	;
	  true
        ).

%% Same for ->>
%% No OidCode is passed outside: we consume it here
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_flmvdattspec(SpecTerm,AttTerm,RefType,ValTermList),
	!,
	compile_pathexp(AttTerm,AttObj,AOidCode,ACode,S),
	( S == [] ->
	    ( ValTermList == [] ->
		mvdattdef_struct(BODYLITERAL,Object,AttObj,RefType,SCode),
		conjunct_code([AOidCode,ACode,SCode],Code),
		Status=[]
	    ;
		%% An mvd spec can have several terms in the value set
		%% (represented by ValTermList). This compiles such
		%% a spec into a conjunction.
		compile_mvdattspec(Object,AttObj,RefType,ValTermList,VOidCode,SCode,Status),
		%% ACode: Code to produce attribute
		%% SCode: code to produce pure attr specs and 
		%%         the objects that represents the values
		(Status == [] ->
		  conjunct_code([AOidCode,VOidCode,ACode,SCode],Code)
	      ;
		  true
	      )
	    )
        ;
	  Status=S
        ).

%% +>>, *+>>
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_flincattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_pathexplist([AttTerm,ValTerm],[AttObj,ValObj],OidCode,OCode,Status),
	( Status == [] ->
	    incattspec_struct(Object,AttObj,RefType,ValObj,SCode),
	    conjunct_code([OidCode,SCode,OCode],Code)
	;
	  true
        ).

%% same for ->->
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_fltolistattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_pathexplist([AttTerm,ValTerm],[AttObj,ValObj],OidCode,OCode,Status),
	( Status == [] ->
	    tolistattspec_struct(Object,AttObj,RefType,ValObj,SCode),
	    %% Fold OidCode in front of the molecule
	    conjunct_code([OidCode,SCode,OCode],Code)
	;
	  true
        ).

%% Obj[true], Obj[fail], Obj[!] translate as true, fail, and !
compile_flspecbody(_Object,SpecTerm,NULL,Code,Status) :-
	is_flpassthru(SpecTerm,P),
	is_flatom(P, Atom, I),
	!,
	(Atom==FL_CUT
	-> cut_struct(I,Code)
	; atomobj_struct(P,Code)
	),
	Status=[].

%% Obj[X>Y], Obj[X=Y], etc.
compile_flspecbody(_Object,SpecTerm,NULL,Code,Status) :-
	is_flpassthru(SpecTerm,P),
	is_flterm(P, Funct, N, Args),
	!,
	compile_prlgterm(Funct,N,Args,TCode,_OidCode,ACode,Status),
	(Status == [] -> conjunct_code([ACode,TCode],Code); true).

%% for O[BoolMeth]
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_flmethspec(SpecTerm,MethTerm),
	!,
	compile_pathexp(MethTerm,MethObj,OidCode,MCode,Status),
	( Status == [] ->
	    methspec_struct(BODYLITERAL,Object,MethObj,SCode),
	    %% Fold OidCode in front of the molecule
	    conjunct_code([OidCode,MCode,SCode],Code)
	;
	  true
        ).

%% for O[*BoolMeth]
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_flimethspec(SpecTerm,IMethTerm),
	!,
	compile_pathexp(IMethTerm,IMethObj,OidCode,IMCode,Status),
	( Status == [] ->
	    imethspec_struct(BODYLITERAL,Object,IMethObj,SCode),
	    %% Fold OidCode in front of the molecule
	    conjunct_code([OidCode,IMCode,SCode],Code)
	;
	  true
        ).

%% O[#M]
compile_flspecbody(Object,SpecTerm,NULL,Code,Status) :-
	is_fltranspec(SpecTerm,TranTerm),
	!,
	compile_pathexp(TranTerm,TranObj,OidCode,TCode,Status),
	( Status == [] ->
	    transpec_struct(BODYLITERAL,Object,TranObj,SCode),
	    conjunct_code([OidCode,TCode,SCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_mvdattspec(+Object,+AttObj,+RefType,+ValTermList,-OidCode,-Code,-Status)
   Arg 4 is a list representing the value set of the attribute.
   This predicate compiles such a spec into a conjunction.
   Each conjunct corresponds to each member of the value set.
   Assumes that AttObj is already an oid
****************************************************************************/
compile_mvdattspec(Object,AttObj,RefType,[T],OidCode,Code,Status) :-
	!,
	compile_pathexp(T,TObj,OidCode,TCode,Status),
	( Status == [] ->
	    mvdattspec_struct(BODYLITERAL,Object,AttObj,RefType,TObj,SCode),
	    conjunct_code([SCode,TCode],Code)
	;
	  true
        ).

compile_mvdattspec(Object,AttObj,RefType,[T|L],OidCode,Code,Status) :-
	!,
	compile_mvdattspec(Object,AttObj,RefType,[T],OidCodeHead,TCode,S),
	( S == [] ->
	    compile_mvdattspec(Object,AttObj,RefType,L,OidCodeTail,LCode,Status),
	    (Status == [] ->
		conjunct_code([TCode,LCode],Code),
		conjunct_code([OidCodeHead,OidCodeTail],OidCode)
	    ;
		true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_flaggregate(+Op,+Var,+GVars,+BodyTerm,-Object,-Code,-Status)
****************************************************************************/
compile_flaggregate(Op,Var,GVars,BodyTerm,Object,Code,Status) :-
	compile_body(BodyTerm,BCode,S),
	( S == [] ->
            (COMPILATION_CONTEXT(compile_with_var_module) ->
                Status =[]
            ;
	        check_aggregate(Var,GVars,BodyTerm,Status)
            ),
	    ( Status == [] ->
		compile_pathexplist([Var|GVars],[VarCode|GVarsCode],NULL,NULL,[]),
		list_struct(GVarsCode,[],GVarsListCode),
		aggregate_struct(Op,VarCode,GVarsListCode,BCode,Object,Code)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  check_aggregate(+Var,+GroupVars,+BodyTerm,-Status)
  check_repeatedvar(+Vars,-Status,-TailStatus)
  allgvar_notin(+SortedVars,-Status,-TailStatus)
****************************************************************************/
check_aggregate(Var,GVars,BodyTerm,Status) :-
	is_flvar(Var,VarName,VarIndex),
	%% Check if the aggregate variable is anonymous.
	( VarName == FL_UNDERSCORE ->
	    compiling_error(VarIndex,ERROR_AVAR,M1),
	    Status=[M1|S1]
	;
	  Status=S1
        ),
	%% Check if any grouping variable is anonymous.
	check_gvar(GVars,S1,S2),
	%% Check if the aggregate variable is also used for grouping.
	( VarName \= FL_UNDERSCORE, is_flvar(U,VarName,_Iu), member(U,GVars) ->
	    compiling_error(VarIndex,AVAR_ASGVAR,M2),
	    S2=[M2|S3]
	;
	  S3=S2
        ),
	%% Check if there are any repeated grouping variables.
	sort(GVars,SVars),
	check_repeatedvar(SVars,S3,S4),
	collect_vars(BodyTerm,BVars),
	%% Check if aggregate variable is used in the aggregate body.
	( (VarName == FL_UNDERSCORE; is_flvar(W,VarName,_Iw), member(W,BVars)) ->
	    S5=S4
        ;
	  compiling_error(VarIndex,AVAR_NOTIN,M5),
	  S4=[M5|S5]
        ),
	%% Check if all grouping variables are used in the aggregate body.
	( subtract_vars(GVars,BVars,L), L \== [] ->
	    sort(L,SL),
	    allgvar_notin(SL,S5,[])
	;
	  S5=[]
        ).


check_gvar([],S,S) :- !.

check_gvar([H|L],Status,TS) :-
	( is_flvar(H,FL_UNDERSCORE,HIndex) ->
	    compiling_error(HIndex,ERROR_GVAR,M),
	    Status=[M|S],
	    check_gvar(L,S,TS)
	;
	  check_gvar(L,Status,TS)
        ).


check_repeatedvar([],S,S) :- !.

check_repeatedvar([H|L],Status,TS) :-
	is_flvar(H,FL_UNDERSCORE,_I),
	!,
	check_repeatedvar(L,Status,TS).

check_repeatedvar([_H],S,S) :- !.

check_repeatedvar([H1,H2|T],Status,TS) :-
	( is_flvar(H1,Name,_I1), is_flvar(H2,Name,I2) ->
	    compiling_error(I2,REPEATED_GVAR,Msg),
	    Status=[Msg|S],
	    check_repeatedvar([H1|T],S,TS)
	;
	  check_repeatedvar([H2|T],Status,TS)
        ).


allgvar_notin([],S,S) :- !.

allgvar_notin([H|L],Status,TS) :-
	is_flvar(H,FL_UNDERSCORE,_I),
	!,
	allgvar_notin(L,Status,TS).

allgvar_notin([H|T],[Msg|S],TS) :-
	is_flvar(H,Name,Index),
	compiling_error(Index,GVAR_NOTIN,Msg),
	remove_dupvars(T,Name,L),
	allgvar_notin(L,S,TS).


/****************************************************************************
  compile_flobjeql(+Obj1,+Obj2,-OidCode,-Code,-Status)
****************************************************************************/
compile_flobjeql(Obj1,Obj2,OidCode,Code,Status) :-
	compile_pathexplist([Obj1,Obj2],[O1,O2],OidCode,OCode,Status),
	( Status == [] ->
	    objeql_struct(BODYLITERAL,O1,O2,OECode),
	    conjunct_code([OCode,OECode],Code)
	;
	  true
	).


/****************************************************************************
  compile_head_fltermobj(+FunctorTerm,+Arity,+ArgList,-Object,-Code,-Status)
****************************************************************************/
compile_head_fltermobj(Funct,N,Args,Object,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_head_argpathexplist(Args,ArgTypes,AObj,Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).

compile_head_fltermobj(Funct,N,Args,Object,Code,Status) :-
	compile_head_pathexplist([Funct|Args],[FObj|AObj],Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).


/****************************************************************************
  compile_head_fltermlit(+FunctorTerm,+Arity,+ArgList,-Code,-Status)

  Compile a term in a rule head in a predicate position.
****************************************************************************/
compile_head_fltermlit(Funct,N,Args,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_head_argpathexplist(Args,ArgTypes,AObj,ObjCode,Status),
	( Status == [] ->
	    termlit_struct(HEADLITERAL,FObj,N,AObj,TObj),
	    conjunct_struct(ObjCode,TObj,Code)
	;
	  true
        ).

compile_head_fltermlit(Funct,N,Args,Code,Status) :-
	compile_head_pathexplist([Funct|Args],[FObj|AObj],ObjCode,Status),
	( Status == [] ->
	    termlit_struct(HEADLITERAL,FObj,N,AObj,TObj),
	    conjunct_struct(ObjCode,TObj,Code)
	;
	  true
        ).


/****************************************************************************
  compile_head_fllist(+ObjTermList,+ObjTerm,+Index,-Object,-Code,-Status)

  Index refers to '['.
****************************************************************************/
compile_head_fllist(ObjTermList,ObjTerm,Index,Object,Code,Status) :-
	compile_head_pathexplist(ObjTermList,ObjList,ObjListCode,S),
	( S == [] ->
	    ( ObjTerm == [] ->
		Obj=[],
		ObjCode=NULL,
		Status=[]
	    ;
	      compile_head_pathexp(ObjTerm,Obj,ObjCode,Status)
	    ),
	    ( Status == [] ->
		list_struct(ObjList,Obj,Index,Object),
		conjunct_struct(ObjListCode,ObjCode,Code)
	    ;
	      true
	    )
	;
	  Status=S
        ).



/****************************************************************************
  compile_head_argpathexplist(+ParserTermList,+ArgTypeList,
                              -ObjectList,-Code,-Status)
  NOTE: This functionality is not exposed to the user.
        Exists for findall, call, and get_residual (see flrarguments.P)
****************************************************************************/
compile_head_argpathexplist([],[],[],NULL,[]).

compile_head_argpathexplist([T|L],[FL_OID|ArgTypeList],[TObj|LObj],Code,Status) :-
	!,
	compile_head_pathexp(T,TObj,TCode,S),
	( S == [] ->
	    compile_head_argpathexplist(L,ArgTypeList,LObj,LCode,Status),
	    (Status == [] -> conjunct_struct(TCode,LCode,Code); true)
	;
	  Status=S
        ).

compile_head_argpathexplist([T|L],[FL_BODYFORMULA|ArgTypeList],[TCode|LObj],Code,Status) :-
	!,
	set_context(goal_reification),
	compile_body(T,TCode1,S),
	reify_struct(TCode1,TCode),
	clear_context(goal_reification),
	( S == [] ->
	    compile_head_argpathexplist(L,ArgTypeList,LObj,Code,Status)
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_pathexplist(+ParserTermList,-ObjectList,-Code,-Status)
****************************************************************************/
compile_head_pathexplist([],[],NULL,[]) :- !.

compile_head_pathexplist([T|L],[TObj|LObj],Code,Status) :-
	compile_head_pathexp(T,TObj,TCode,S),
	( S == [] ->
	    compile_head_pathexplist(L,LObj,LCode,Status),
	    (Status == [] -> conjunct_struct(TCode,LCode,Code); true)
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_pathexp(+ParserTerm,-Object,-Code,-Status)

  Note: It is for skolemization.
****************************************************************************/
compile_head_pathexp(ParserTerm,Object,NULL,[]) :-
	( is_flatom(ParserTerm,_A) ->
	    atomobj_struct(ParserTerm,Object)

	; is_flnumber(ParserTerm,_N) ->
	    numobj_struct(ParserTerm,Object)

	; is_flvar(ParserTerm,Name,Index) ->
	    compile_flvar(Name,Index,Object)

	; is_flstring(ParserTerm,_S) ->
	    strobj_struct(ParserTerm,Object)

	; is_fltoken(ParserTerm,Token,Index) ->
	    compile_head_fltoken(Token,Index,Object)

	; is_fltoken(ParserTerm,Token,Num,Index) ->      
	    compile_head_fltoken(Token,Num,Index,Object) 
	),
	!.

compile_head_pathexp(ParserTerm,Object,Code,Status) :-
	( is_flbirelate(ParserTerm,OT1,RelType,OT2) ->
	    compile_head_flbirelate(OT1,RelType,OT2,Object,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_head_flobjspec(ObjTerm,Spec,Object,Code,Status)

	; is_flobjref(ParserTerm,ObjTerm,RefType,AttTerm) ->
	    compile_head_flobjref(ObjTerm,RefType,AttTerm,Object,Code,Status)

	; is_reifyop(ParserTerm,Formula) ->
            set_context(compile_with_var_module),
	    %% Code: code to get Object
	    compile_reifyop(Formula,Object,Code,Status),
            clear_context(compile_with_var_module)

	; is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_head_fltermobj(Funct,N,Args,Object,Code,Status)

	; is_fllist(ParserTerm,L,T,I) ->
	    compile_head_fllist(L,T,I,Object,Code,Status)
	;
	  is_flworkspace(ParserTerm,P,WS),
	  compile_head_wspathexp(P,WS,Object,Code,Status)
        ).


/****************************************************************************
  compile_head_fltoken(+Token,+Index,-Object)

  Handles _#, _#123, _@, atoms
****************************************************************************/
compile_head_fltoken(Token,Index,Object) :-
	( Token == FL_NEWOID ->
	    new_oidobj(Index,Object)
        ; Token == FL_THISMODULE ->
	    thismodule_struct(Object)
        ;
	  atomobj_struct(Token,Index,Object)
	).

/****************************************************************************
  compile_head_fltoken(+Token,+Num,+Index,-Object)
****************************************************************************/
compile_head_fltoken(Token,Num,Index,Object) :-
        ( Token == FL_NEWOID ->
            flora_get_counter(RULE_NUM, Rule_num), 
	    new_oidobj(Rule_num,Num,Index,Object)
        ;
          atomobj_struct(Token,Index,Object)
        ).


/****************************************************************************
  compile_head_flobjref(+ObjT,+RefType,+AttT,-Object,-Code,-Status)
****************************************************************************/
compile_head_flobjref(ObjTerm,RefType,AttTerm,Object,Code,Status) :-
	compile_head_pathexplist([ObjTerm,AttTerm],[Obj,Att],OACode,Status),
	( Status == [] ->
	    %% Approximate the textual information for the new variable.
	    approximate_index(AttTerm,Index),
	    head_objref_struct(Obj,RefType,Att,Index,Object,TCode),
	    conjunct_struct(OACode,TCode,Code)
	;
	  true
        ).


/****************************************************************************
  compile_head_flbirelate(+OT1,+RelType,+OT2,-Object,-Code,-Status)
****************************************************************************/
compile_head_flbirelate(ObjTerm1,RelType,ObjTerm2,Obj1,Code,Status) :-
	compile_head_pathexplist([ObjTerm1,ObjTerm2],[Obj1,Obj2],OCode,Status),
	( Status == [] ->
	    birelate_struct(HEADLITERAL,Obj1,RelType,Obj2,TCode),
	    conjunct_struct(OCode,TCode,Code)
	;
	  true
        ).


/****************************************************************************
  compile_head_flobjspec(+ObjTerm,+SpecBody,-Object,-Code,-Status)
****************************************************************************/
compile_head_flobjspec(ObjTerm,SpecBody,Object,Code,Status) :-
	( SpecBody == [] ->
	    ( is_flobjref(ObjTerm,OTerm,RefType,ATerm) ->
		compile_head_flobjref(OTerm,RefType,ATerm,Object,Code,Status)
	    ;
	      compile_head_pathexp(ObjTerm,Object,ObjCode,Status),
	      ( Status == [] ->
		  objexists_struct(HEADLITERAL,Object,ECode),
		  conjunct_struct(ObjCode,ECode,Code)
	      ;
	        true
	      )
	    )
	;
	  compile_head_pathexp(ObjTerm,Object,ObjCode,S),
	  ( S == [] ->
	      compile_head_flspecbody(Object,SpecBody,SCode,Status),
	      (Status == [] -> conjunct_struct(ObjCode,SCode,Code); true)
	  ;
	    Status=S
	  )
        ).


/****************************************************************************
  compile_head_flspecbody(+Object,+SpecTerm,-Code,-Status)
  compile_head_mvdattspec(+Object,+AttObj,+RefType,+VL,-Code,-Status)
****************************************************************************/
compile_head_flspecbody(Object,SpecTerm,Code,Status) :-
	is_flconjunct(SpecTerm,L,R),
	!,
	compile_head_flspecbody(Object,L,LCode,S),
	( S == [] ->
	    compile_head_flspecbody(Object,R,RCode,Status),
	    (Status == [] -> conjunct_struct(LCode,RCode,Code); true)
	;
	  Status=S
        ).

compile_head_flspecbody(Object,SpecTerm,Code,Status) :-
	is_flfdattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_head_pathexplist([AttTerm,ValTerm],[AttObj,ValObj],VACode,Status),
	( Status == [] ->
	    fdattspec_struct(HEADLITERAL,Object,AttObj,RefType,ValObj,SCode),
	    conjunct_struct(VACode,SCode,Code)
	;
	  true
        ).

compile_head_flspecbody(Object,SpecTerm,Code,Status) :-
	is_flmvdattspec(SpecTerm,AttTerm,RefType,VL),
	!,
	compile_head_pathexp(AttTerm,AObj,ACode,S),
	( S == [] ->
	    ( VL == [] ->
		mvdattdef_struct(HEADLITERAL,Object,AObj,RefType,SCode),
		conjunct_struct(ACode,SCode,Code),
		Status=[]
	    ;
	      compile_head_mvdattspec(Object,AObj,RefType,VL,VCode,Status),
	      (Status == [] -> conjunct_struct(ACode,VCode,Code); true)
	    )
        ;
	  Status=S
        ).

compile_head_flspecbody(Object,SpecTerm,Code,Status) :-
	is_flmethspec(SpecTerm,MethTerm),
	!,
	compile_head_pathexp(MethTerm,MethObj,MCode,Status),
	( Status == [] ->
	    methspec_struct(HEADLITERAL,Object,MethObj,SCode),
	    conjunct_struct(MCode,SCode,Code)
	;
	  true
        ).

compile_head_flspecbody(Object,SpecTerm,Code,Status) :-
	is_flimethspec(SpecTerm,IMethTerm),
	!,
	compile_head_pathexp(IMethTerm,IMethObj,IMCode,Status),
	( Status == [] ->
	    imethspec_struct(HEADLITERAL,Object,IMethObj,SCode),
	    conjunct_struct(IMCode,SCode,Code)
	;
	  true
        ).

compile_head_flspecbody(Object,SpecTerm,Code,Status) :-
	is_fltranspec(SpecTerm,TranTerm),
	!,
	compile_head_pathexp(TranTerm,TranObj,TCode,Status),
	( Status == [] ->
	    transpec_struct(HEADLITERAL,Object,TranObj,SCode),
	    conjunct_struct(TCode,SCode,Code)
	;
	  true
        ).


compile_head_mvdattspec(_Object,_AttObj,_RefType,[],NULL,[]) :- !.

compile_head_mvdattspec(Object,AttObj,RefType,[T|L],Code,Status) :-
	!,
	compile_head_pathexp(T,TObj,TCode,S),
	( S == [] ->
	    compile_head_mvdattspec(Object,AttObj,RefType,L,LCode,Status),
	    ( Status == [] ->
		mvdattspec_struct(HEADLITERAL,Object,AttObj,RefType,TObj,SCode),
		conjunct_struct(LCode,SCode,LSCode),
		conjunct_struct(TCode,LSCode,Code)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_flobjeql(+Obj1,+Obj2,-Code,-Status)
  X :=: Y found in a rule head
****************************************************************************/
compile_head_flobjeql(Obj1,Obj2,Code,Status) :-
	compile_head_pathexplist([Obj1,Obj2],[O1,O2],OCode,Status),
	( Status == [] ->
	    objeql_struct(HEADLITERAL,O1,O2,OECode),
	    conjunct_struct(OCode,OECode,Code),
	    approximate_index(Obj1,Idx),
	    report_option(FLOBJEQLDEF,Idx)
	;
	  true
	).


/****************************************************************************
  compile_floraliblit(+ParserTerm,+Workspace,-OidCode,-Code,-Status)

  This procedure compiles a literal that is associated with a Flora system
  module specification.
****************************************************************************/
compile_floraliblit(ParserTerm,WS,OidCode,Code,Status) :-
	%% Flora system modules are like normal user modules except that
	%% users cannot load files into them
	is_flatom(WS,WSName,Index),
	report_option(FLSYSMOD(WSName),Index),
	atomobj_struct(WSName,Index,WSNameCode),
	floralib_struct(WSNameCode,WSCode),
	compile_wsliteral(ParserTerm,WSCode,OidCode,Code,Status).


/****************************************************************************
  compile_wsliteral(+ParserTerm,+Workspace,-OidCode,-Code,-Status)
****************************************************************************/
compile_wsliteral(ParserTerm,WS,OidCode,WSCode,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_wstermlit(Funct,N,Args,WS,OidCode,WSCode,Status)

	; is_flvar(ParserTerm,VarName,Index) ->
	    %% Is this possible? Should be taken care by the libmodlit code
	    attach_workspace(WS,
			     compile_flvar(VarName,Index,VarCode),
			     VarCode,WSCode),
	    OidCode = NULL,
	    Status = []

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    compile_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,_Obj,OidCode,WSCode,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_wsflobjspec(ObjTerm,Spec,WS,_Obj,OidCode,WSCode,Status)

	; is_flobjeql(ParserTerm,O1,O2) ->
	    compile_wsflobjeql(O1,O2,WS,OidCode,WSCode,Status)

	; is_fldirective(ParserTerm,DirectList,_Idx) ->
	    compile_exec_directive(DirectList,WS,WSCode,Status),
	    OidCode=NULL
	;
	    attach_workspace(WS,
			     atomlit_struct(BODYLITERAL,ParserTerm,Code),
			     Code,WSCode),
	    OidCode=NULL,
	    Status=[]
	).


/****************************************************************************
  compile_floralibobj(+ParserTerm,+Workspace,-Object,-OidCode,-Code,-Status)
****************************************************************************/
compile_floralibobj(ParserTerm,WS,Object,OidCode,Code,Status) :-
	is_flatom(WS,WSName,Index),
	report_option(FLSYSMOD(WSName),Index),
	atomobj_struct(WSName,Index,WSNameCode),
	floralib_struct(WSNameCode,WSCode),
	compile_wspathexp(ParserTerm,WSCode,Object,OidCode,Code,Status).


/****************************************************************************
  compile_wspathexp(+ParserTerm,+Workspace,-Object,-OidCode,-Code,-Status)
****************************************************************************/
compile_wspathexp(ParserTerm,WS,Object,OidCode,Code,Status) :-
	(   %% pred(Term@...)
	    %% Note: We have to create code to compute X@.... We put this
	    %% code in OidCode so that it would precede the code for pred(...)
	    atomlit_struct(BODYLITERAL,ParserTerm,A) ->
	    workspaceobj_struct(A,WS,Object,OidCode),
	    Code=NULL,
	    Status=[]

	; is_flterm(ParserTerm,Funct,N,Args) ->
	    abort('Compiler - DEPRECATED!!! unreified predicate in obj pos'),
	    compile_wstermobj(Funct,N,Args,WS,Object,OidCode,Code,Status)

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    abort('Compiler - DEPRECATED!!! unreified ISA in obj pos'),
	    compile_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,Object,OidCode,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    abort('Compiler - DEPRECATED!!! unreified molecule in obj pos'),
	    compile_wsflobjspec(ObjTerm,Spec,WS,Object,OidCode,Code,Status)

	%% pred(X@...)
	%% Note: We have have to create code to compute X@..., so we put
	%% this code in OidCode so that it would precede the code for pred(...)
	; is_flvar(ParserTerm,VarName,VarIndex) ->
	    compile_flvar(VarName,VarIndex,VarCode),
	    workspaceobj_struct(VarCode,WS,Object,OidCode),
	    Code=NULL,
	    Status = []
	;
	  is_flobjref(ParserTerm,ObjTerm,RefType,AttTerm),
	  compile_wsflobjref(ObjTerm,RefType,AttTerm,WS,Object,OidCode,Code,Status)
	).


/****************************************************************************
  compile_wsflpathexplist(+ParserTermList,+Workspace,-ObjectList,-OidCode,-Code,-Status)
****************************************************************************/
compile_wsflpathexplist([],_WS,[],NULL,NULL,[]).

compile_wsflpathexplist([T|L],WS,[TObj|LObj],OidCode,Code,Status) :-
	compile_wsflpathexp(T,WS,TObj,OidCodeHead,TCode,S),
	( S == [] ->
	    compile_wsflpathexplist(L,WS,LObj,OidCodeTail,LCode,Status),
	    (Status == [] ->
		conjunct_code([TCode,LCode],Code),
		conjunct_code([OidCodeHead,OidCodeTail],OidCode)
	    ; true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_wsflargpathexplist(+ParserTermList,+ArgTypeList,+WS,
                             -ObjectList,-OidCode,-Code,-Status)
  NOTE: This functionality is not exposed to the user.
        Exists for findall, call, and get_residual (see flrarguments.P)
****************************************************************************/
compile_wsflargpathexplist([],[],_WS,[],NULL,NULL,[]) :- !.

compile_wsflargpathexplist([T|L],[FL_OID|ArgTypeList],WS,[TObj|LObj],OidCode,Code,Status) :-
	!,
	compile_wsflpathexp(T,WS,TObj,OidCodeHead,TCode,S),
	( S == [] ->
	    compile_wsflargpathexplist(L,ArgTypeList,WS,LObj,OidCodeTail,LCode,Status),
	    (Status == [] ->
		conjunct_code([TCode,LCode],Code),
		conjunct_code([OidCodeHead,OidCodeTail],OidCode)
	    ; true
	    )
	;
	  Status=S
        ).

compile_wsflargpathexplist([T|L],[FL_BODYFORMULA|ArgTypeList],WS,[TCode|LObj],OidCode,Code,Status) :-
	!,
	%% workspace not distributive over nested "meta"
	%%compile_body(T,TCode,S),
	set_context(goal_reification),
	compile_body(T,TCode1,S),
	reify_struct(TCode1,TCode),
	clear_context(goal_reification),
	( S == [] ->
	    compile_wsflargpathexplist(L,ArgTypeList,WS,LObj,OidCode,Code,Status)
	;
	  Status=S
        ).


/****************************************************************************
  compile_wsflpathexp(+ParserTerm,+Workspace,-Object,-OidCode,-Code,-Status)

  Note: The difference between compile_wsflpathexp and compile_wspathexp
        is that compile_wsflpathexp applies workspace only to F-Logic
        constructs.
****************************************************************************/
compile_wsflpathexp(ParserTerm,WS,Object,OidCode,Code,Status) :-
	( is_flobjref(ParserTerm,ObjTerm,RefType,AttTerm) ->
	    compile_wsflobjref(ObjTerm,RefType,AttTerm,WS,Object,OidCode,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_wsflobjspec(ObjTerm,Spec,WS,Object,OidCode,Code,Status)

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    compile_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,Object,OidCode,Code,Status)

	; is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_wsfltermobj(Funct,N,Args,WS,Object,OidCode,Code,Status)

	; is_fllist(ParserTerm,L,T,I) ->
	    compile_wsfllist(L,T,I,WS,Object,OidCode,Code,Status)

	; is_flworkspace(ParserTerm,P,NestedWS) ->
	    compile_wspathexp(P,NestedWS,Object,OidCode,Code,Status)
	;
	  %% workspace not distributive over nested aggregates
	  compile_pathexp(ParserTerm,Object,OidCode,Code,Status)
        ).


/****************************************************************************
  compile_wstermobj(+FunctorTerm,+Arity,+ArgList,+Workspace,-Object,-OidCode,-Code,-Status)
****************************************************************************/
compile_wstermobj(Funct,N,Args,WS,Object,OidCode,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_wsflargpathexplist(Args,ArgTypes,WS,AObj,OidCode,TCode,Status),
	( Status == [] ->
	    termlit_struct(BODYLITERAL,FObj,N,AObj,O),
	    workspaceobj_struct(O,WS,Object,WCode),
	    conjunct_code([TCode,WCode],Code)
	;
	  true
	).

compile_wstermobj(Funct,N,Args,WS,Object,OidCode,Code,Status) :-
	compile_wsflpathexplist([Funct|Args],WS,[FObj|AObj],OidCode,TCode,Status),
	( Status == [] ->
	    termlit_struct(BODYLITERAL,FObj,N,AObj,O),
	    workspaceobj_struct(O,WS,Object,WCode),
	    conjunct_code([TCode,WCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_wsfltermobj(+FunctorTerm,+Arity,+ArgList,+Workspace,-Object,-OidCode,-Code,-Status)

  Note: The difference between compile_wsfltermobj and compile_wstermobj
        is that compile_wsfltermobj applies workspace only to F-Logic
        constructs.  
****************************************************************************/
compile_wsfltermobj(Funct,N,Args,WS,Object,OidCode,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_wsflargpathexplist(Args,ArgTypes,WS,AObj,OidCode,Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).

compile_wsfltermobj(Funct,N,Args,WS,Object,OidCode,Code,Status) :-
	compile_wsflpathexplist([Funct|Args],WS,[FObj|AObj],OidCode,Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).


/****************************************************************************
  compile_wstermlit(+FunctorTerm,+Arity,+ArgList,+Workspace,-OidCode,-Code,-Status)
****************************************************************************/
compile_wstermlit(Funct,N,Args,WS,OidCode,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_wsflargpathexplist(Args,ArgTypes,WS,AObj,OidCode,ObjCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     termlit_struct(BODYLITERAL,FObj,N,AObj,TCode),
			     TCode,WSCode),
	    conjunct_code([WSCode,ObjCode],Code)
	;
	  true
        ).

compile_wstermlit(Funct,N,Args,WS,OidCode,Code,Status) :-
	compile_wsflpathexplist([Funct|Args],WS,[FObj|AObj],OidCode,ObjCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     termlit_struct(BODYLITERAL,FObj,N,AObj,TCode),
			     TCode,WSCode),
	    conjunct_code([WSCode,ObjCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_wsfllist(+ObjTermList,+ObjTerm,+Index,+WS,-Object,-OidCode,-Code,-Status)
    Lists are like this: [a,b,c|rest]
    ObjTermList refers to the list [a,b,c] and ObjTerm to rest.
****************************************************************************/
compile_wsfllist(ObjTermList,ObjTerm,Index,WS,Object,OidCode,Code,Status) :-
	compile_wsflpathexplist(ObjTermList,WS,ObjList,OidCodeList,ObjListCode,S),
	( S == [] ->
	    ( ObjTerm == [] ->
		Obj=[],
		ObjCode=NULL,
		Status=[]
	    ;
	      compile_wsflpathexp(ObjTerm,WS,Obj,OidCodeObj,ObjCode,Status)
	    ),
	    ( Status == [] ->
		list_struct(ObjList,Obj,Index,Object),
		conjunct_code([ObjListCode,ObjCode],Code),
		conjunct_code([OidCodeList,OidCodeObj],OidCode)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_wsflobjref(+ObjTerm,+RefType,+AttTerm,+Workspace,-Object,-OidCode,-Code,-Status)

  Process an object reference like a.b.c@module
  An objref can be more complex, e.g., a[f->g].b[h->>p].c[k->u]@module
****************************************************************************/
compile_wsflobjref(ObjTerm,RefType,AttTerm,WS,Object,OidCode,Code,Status) :-
	compile_wsflpathexplist([ObjTerm,AttTerm],WS,[Obj,Att],OidCodeList,OACode,Status),
	( Status == [] ->
	    %% Approximate the textual information for the new variable.
	    approximate_index(AttTerm,Index),
	    attach_workspace(WS,
			    body_objref_struct(Obj,RefType,Att,Index,Object,TCode),
			     TCode,WTCode),
	    Code = OACode,
	    conjunct_code([OidCodeList,WTCode],OidCode)
	;
	  true
        ).


/****************************************************************************
  compile_wsflbirelate(+ObjTerm1,+RelType,+ObjTerm2,+Workdpace,-Object,-OidCode,-Code,-Status)
****************************************************************************/
compile_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,Obj1,OidCode,Code,Status) :-
	compile_wsflpathexplist([ObjTerm1,ObjTerm2],WS,[Obj1,Obj2],OidCode,OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     birelate_struct(BODYLITERAL,Obj1,RelType,Obj2,TCode),
			     TCode,WTCode),
	    conjunct_code([WTCode,OCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_wsflobjspec(+ObjTerm,+SpecBody,+Workspace,-Object,-OidCode,-Code,-Status)

  Code produced by this and similar predicates is divided into
  OidCode and Code. 
  OidCode is the code needed to compute the attribute of molecule
  and the oid, and the oid of the value part (in ->, ->>, etc.)
  Code represents the code needed to compute the the attribute specification.
  For instance, in  a.b[c.d->e.f],
      OidCode will represent the computation of c.d and e.d:
	 prand(prfd(a,b,_newvar1),prand(prfd(c,d,_newvar2),prfd(e,d,_newvar3)))
      Code will represent the -> part:
                 prfd(_newvar1,_newvar2,_newvar3)
****************************************************************************/
compile_wsflobjspec(ObjTerm,SpecBody,WS,Object,OidCode,Code,Status) :-
	( SpecBody == [] ->
	    ( is_flobjref(ObjTerm,OTerm,RefType,ATerm) ->
		compile_wsflpathexplist([OTerm,ATerm],WS,[OObj,AObj],OidCode,ObjCode,Status),
		( Status == [] ->
		    attach_workspace(WS,
				     objattdef_struct(BODYLITERAL,OObj,RefType,AObj,TCode),
				     TCode,WTCode),
		    conjunct_code([WTCode,ObjCode],Code)
		;
		  true
	        )
	    ;
		%% object exists test: a.b.c[]@module
		compile_wsflpathexp(ObjTerm,WS,Object,OidCode,ObjCode,Status),
		( Status == [] ->
		    attach_workspace(WS,
				     objexists_struct(BODYLITERAL,Object,ECode),
				     ECode,WSECode),
		    conjunct_code([WSECode,ObjCode],Code)
		;
		    true
		)
	    )
	; % oid spec plus object spec. something like a.b[c->d]@module
	  compile_wsflpathexp(ObjTerm,WS,Object,ObjOidCode,ObjCode,S),
	  ( S == [] ->
	      compile_wsflspecbody(Object,SpecBody,WS,SpecOidCode,SpecCode,Status),
	      (Status == [] ->
		  conjunct_code([ObjCode,SpecCode],Code),
		  conjunct_code([ObjOidCode,SpecOidCode],OidCode)
	      ; 
		  true
	      )
	  ;
	    Status=S
          )
        ).


/****************************************************************************
  compile_wsflspecbody(+Object,+SpecTerm,+Workspace,-OidCode,-Code,-Status)
****************************************************************************/
compile_wsflspecbody(Object,SpecTerm,WS,OidCode,Code,Status) :-
	is_flconjunct(SpecTerm,L,R),
	!,
	compile_wsflspecbody(Object,L,WS,OidCode,LCode,S),
	( S == [] ->
	    compile_wsflspecbody(Object,R,WS,OidCode,RCode,Status),
	    (Status == [] -> conjunct_code([LCode,RCode],Code); true)
	;
	  Status=S
        ).

compile_wsflspecbody(Object,SpecTerm,WS,OidCode,Code,Status) :-
	is_fldisjunct(SpecTerm,L,R),
	!,
	compile_wsflspecbody(Object,L,WS,OidCode,LCode,S),
	( S == [] ->
	    compile_wsflspecbody(Object,R,WS,OidCode,RCode,Status),
	    (Status == [] -> disjunct_struct(LCode,RCode,Code); true)
	;
	  Status=S
        ).

compile_wsflspecbody(Object,SpecTerm,WS,OidCode,Code,Status) :-
	is_flnot(SpecTerm,G),
	!,
	compile_wsflspecbody(Object,G,WS,OidCode,GCode,Status),
	(Status == [] ->
	    conjunct_code([OidCode,GCode],CombinedGCode),
	    not_struct(CombinedGCode,Code)
	; true
	).

compile_wsflspecbody(Object,SpecTerm,WS,OidCode,Code,Status) :-
	is_fltnot(SpecTerm,G),
	!,
	compile_wsflspecbody(Object,G,WS,OidCode,GCode,Status),
	(Status == [] ->
	    conjunct_code([OidCode,GCode],CombinedGCode),
	    tnot_struct(CombinedGCode,Code)
	; true
	).

%% OidCodeList below gets bound to code needed to produce
%% the attribute (M) and the value (V). We conjunct this code in front of the
%% code for the molecule
%% NULL means tht we don't pass OID code out, because we use it right here.
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_flfdattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_wsflpathexplist([AttTerm,ValTerm],WS,[AttObj,ValObj],OidCode,OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     fdattspec_struct(BODYLITERAL,Object,AttObj,RefType,ValObj,SCode),
			     SCode,WSCode),
	    %% WSCode: code to produce object reference, attribute, and value
	    %% OCode: code for the pure attribute spec of the object
	    %% OidCode: code to produce the attribute and the value
	    conjunct_code([OidCode,WSCode,OCode],Code)
	;
	  true
        ).

%% No OidCode is passed outside: we consume it here
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_flmvdattspec(SpecTerm,AttTerm,RefType,ValTermList),
	!,
	compile_wsflpathexp(AttTerm,WS,AttObj,AOidCode,ACode,S),
	( S == [] ->
	    ( ValTermList == [] ->
		attach_workspace(WS,
				 mvdattdef_struct(BODYLITERAL,Object,AttObj,RefType,SCode),
				 SCode,WSCode),
		%% Fold OidCode in front of molecule
		conjunct_code([AOidCode,ACode,WSCode],Code),
		Status=[]
	    ;
	      compile_wsmvdattspec(Object,AttObj,RefType,ValTermList,WS,VOidCode,WSCode,Status),
	      (Status == [] ->
		  %% ACode: Code to produce attribute
		  %% WSCode: code to produce pure attr specs and 
		  %%         the objects that represents the values
		  conjunct_code([AOidCode,VOidCode,ACode,WSCode],Code)
	      ; true
	      )
	    )
        ;
	  Status=S
        ).


%% +>>, *+>>@module
%% NULL means: consume OidCode for attr and val here -- don't pass up the chain
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_flincattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_wsflpathexplist([AttTerm,ValTerm],WS,[AttObj,ValObj],OidCode,OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     incattspec_struct(Object,AttObj,RefType,ValObj,SCode),
			     SCode,WSCode),
	    %% Fold OidCode in front of molecule
	    conjunct_code([OidCode,WSCode,OCode],Code)
	;
	  true
        ).

%% same for ->->@module
%% NULL means: consume OidCode for attr and val here -- don't pass up the chain
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_fltolistattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_wsflpathexplist([AttTerm,ValTerm],WS,[AttObj,ValObj],OidCode,OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     tolistattspec_struct(Object,AttObj,RefType,ValObj,SCode),
			     SCode,WSCode),
	    conjunct_code([OidCode,WSCode,OCode],Code)
	;
	  true
        ).

%% Obj[true], Obj[fail], Obj[!] translate as true, fail, and !
compile_wsflspecbody(_Object,SpecTerm,_WS,NULL,Code,Status) :-
	is_flpassthru(SpecTerm,P),
	is_flatom(P, Atom, I),
	!,
	(Atom==FL_CUT
	-> cut_struct(I,Code)
	; atomobj_struct(P,Code)
	),
	Status=[].

%% Obj[X>Y], Obj[X=Y], etc.
compile_wsflspecbody(_Object,SpecTerm,_WS,NULL,Code,Status) :-
	is_flpassthru(SpecTerm,P),
	is_flterm(P, Funct, N, Args),
	!,
	compile_prlgterm(Funct,N,Args,TCode,_OidCode,ACode,Status),
	(Status == [] -> conjunct_code([ACode,TCode],Code); true).

%% for O[BoolMeth]@module
%% NULL means: consume OidCode for attr and val here -- don't pass up the chain
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_flmethspec(SpecTerm,MethTerm),
	!,
	compile_wsflpathexp(MethTerm,WS,MethObj,OidCode,MCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     methspec_struct(BODYLITERAL,Object,MethObj,SCode),
			     SCode,WSCode),
	    conjunct_code([OidCode,MCode,WSCode],Code)
	;
	  true
        ).

%% for O[*BoolMeth]@module
%% NULL means: consume OidCode for attr and val here -- don't pass up the chain
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_flimethspec(SpecTerm,IMethTerm),
	!,
	compile_wsflpathexp(IMethTerm,WS,IMethObj,OidCode,IMCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     imethspec_struct(BODYLITERAL,Object,IMethObj,SCode),
			     SCode,WSCode),
	    %% Fold OidCode in front of molecule
	    conjunct_code([OidCode,IMCode,WSCode],Code)
	;
	  true
        ).

%% O[#M]@module
compile_wsflspecbody(Object,SpecTerm,WS,NULL,Code,Status) :-
	is_fltranspec(SpecTerm,TranTerm),
	!,
	compile_wsflpathexp(TranTerm,WS,TranObj,OidCode,TCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     transpec_struct(BODYLITERAL,Object,TranObj,SCode),
			     SCode,WSCode),
	    conjunct_code([OidCode,TCode,WSCode],Code)
	;
	  true
        ).


/****************************************************************************
  compile_wsmvdattspec(+Object,+AttObj,+RefType,+ValTermList,+Workspace,-OidCode,-Code,-Status)

  Compiles ->>, *->>, etc., when they have one or more value terms
****************************************************************************/
compile_wsmvdattspec(Object,AttObj,RefType,[T],WS,OidCode,Code,Status) :-
	!,
	compile_wsflpathexp(T,WS,TObj,OidCode,TCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     mvdattspec_struct(BODYLITERAL,Object,AttObj,RefType,TObj,SCode),
			     SCode,WSCode),
	    conjunct_code([WSCode,TCode],Code)
	;
	  true
        ).

compile_wsmvdattspec(Object,AttObj,RefType,[T|L],WS,OidCode,Code,Status) :-
	!,
	compile_wsmvdattspec(Object,AttObj,RefType,[T],WS,OidCodeHead,WTCode,S),
	( S == [] ->
	    compile_wsmvdattspec(Object,AttObj,RefType,L,WS,OidCodeTail,WLCode,Status),
	    (Status == [] ->
		conjunct_code([WTCode,WLCode],Code),
		conjunct_code([OidCodeHead,OidCodeTail],OidCode)
	    ; true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_wsflobjeql(+Obj1,+Obj2,+Workspace,-OidCode,-Code,-Status)
****************************************************************************/
compile_wsflobjeql(Obj1,Obj2,WS,OidCode,Code,Status) :-
	compile_wsflpathexplist([Obj1,Obj2],WS,[O1,O2],OidCode,OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     objeql_struct(BODYLITERAL,O1,O2,OECode),
			     OECode,WSCode),
	    conjunct_code([OCode,WSCode],Code)
	;
	  true
	).


/****************************************************************************
  compile_reifyop(+Formula,-Object,-Status)
  Compiling ${...}
****************************************************************************/
compile_reifyop(Formula,Object,OidCode,Status) :-
	Formula = [Rule|_],
	(is_fldynrule(Rule,_Head,_Body)
	; is_flruleworkspace(Rule,_RealRule,_WS)
	),
	!,
	set_context(rule_reification),
        %% singleton/unbound vars are flagged in reified/inserted rules
	compile_fldynrule(FL_INSERTRULE,Rule,Object,Status),
	clear_context(rule_reification),
	OidCode=NULL.

compile_reifyop(Formula,Object,OidCode,Status) :-
	set_context(goal_reification),
	compile_body(Formula,Object1,Status),
	clear_context(goal_reification),
	(is_florasyslib_struct(Object1, Index,FLLIBMODLIT,_N,Args)
	%% It is compiled into a LIBMODLIT/3: replace with LIBMODOBJ
	->
	    new_varobj(Index,Object),
	    append(Args,[Object],NewArgs),
	    %% LIBMODLIT/3 already has the caller argument -- no
	    %% need to add it here
	    florasyslib_struct(Index,FLLIBMODOBJ,4,NewArgs,OidCode)
	;
	    reify_struct(Object1,Object), OidCode = NULL
	).


/****************************************************************************
  compile_prologliblit(+ParserTerm,-OidCode,-Code,-Status)

  Compiles Prolog library call @prolog()
****************************************************************************/
compile_prologliblit(ParserTerm,OidCode,Code,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_prlgterm(Funct,N,Args,TCode,OidCode,ACode,Status),
	    (Status == [] -> conjunct_code([ACode,TCode],Code); true)
	;
	    atomobj_struct(ParserTerm,FObj),
	    N=0,
	    prologterm_struct(FObj,0,[],Code),
	    OidCode=NULL,
	    Status=[]
	),
	!.


/****************************************************************************
  compile_prologliblit(+ParserTerm,+Module,-OidCode,-Code,-Status)

  Compiles Prolog library call @prolog(module)
****************************************************************************/
compile_prologliblit(ParserTerm,Module,OidCode,Code,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    is_flatom(Funct,FAtom),
	    compile_prlgterm(Funct,N,Args,TCode,OidCode,ACode,Status)
	;
	    is_flatom(ParserTerm,FAtom),
	    atomobj_struct(ParserTerm,FObj),
	    N=0,
	    prologterm_struct(FObj,0,[],TCode),
	    ACode=NULL,
	    OidCode=NULL,
	    Status=[]
	),
	( Status == [] ->
	    %% build a special structure for the coder
	    prologliblit_struct(TCode,PCode),
	    conjunct_code([ACode,PCode],Code),
	    %% generate an import statement for the corresponding XSB predicate
	    is_flatom(Module,MName),
	    import_struct(FAtom,N,MName,ICode),
	    directive_struct(ICode,DCode),
	    report_directive(DCode)
	;
	  true
	),
	!.


/****************************************************************************
  compile_prologallliblit(+ParserTerm,-OidCode,-Code,-Status)

  Compiles Prolog library call @prologall()
****************************************************************************/
compile_prologallliblit(ParserTerm,OidCode,Code,Status) :-
	compile_prologliblit(ParserTerm,OidCode,PrelimCode,Status),
	( % here PrelimCode is bound and we decompose it
	  conjunct_struct(ACode,PrelimTermCode,PrelimCode), !
	; PrelimCode = PrelimTermCode, ACode=NULL
	),
	%% Here PrelimTermCode is bound and we decompose it
	prologterm_struct(FunctCode,N,ArgsCode,PrelimTermCode),
	new_varobjlist(N,NewVarList),
	generate_convert_to_prolog_code(ArgsCode,NewVarList,ToPrologCode),
	prologterm_struct(FunctCode,N,NewVarList,TermCode),
	generate_convert_from_prolog_code(ArgsCode,NewVarList,FromPrologCode),
	conjunct_code([ACode,ToPrologCode,TermCode,FromPrologCode],Code).


/****************************************************************************
  compile_prologallliblit(+ParserTerm,+Module,-OidCode,-Code,-Status)

  Compiles Prolog library call @prologall(module)
****************************************************************************/
compile_prologallliblit(ParserTerm,Module,OidCode,Code,Status) :-
	compile_prologliblit(ParserTerm,Module,OidCode,PrelimCode,Status),
	( % here PrelimCode is bound and we decompose it
	  conjunct_struct(ACode,PrelimTermLitCode,PrelimCode), !
	; PrelimCode = PrelimTermLitCode, ACode=NULL
	),
	%% PrelimTermLitCode is bound and we decompose it
	prologliblit_struct(PrelimTermCode,PrelimTermLitCode),
	%% PrelimTermCode is bound and we decompose it
	prologterm_struct(FunctCode,N,ArgsCode,PrelimTermCode),
	new_varobjlist(N,NewVarList),
	generate_convert_to_prolog_code(ArgsCode,NewVarList,ToPrologCode),
	prologterm_struct(FunctCode,N,NewVarList,TermCode),
	prologliblit_struct(TermCode,TermLitCode),
	generate_convert_from_prolog_code(ArgsCode,NewVarList,FromPrologCode),
	conjunct_code([ACode,ToPrologCode,TermLitCode,FromPrologCode],Code).


/****************************************************************************
  compile_prologlibobj(+ParserTerm,-Object,-OidCode,-Code,-Status)

  Compiles Prolog library call @prolog() in the arguments position
  E.g., f(member(X,[a])@prolog())
  This feature might be userful for meta-programming.  
****************************************************************************/
compile_prologlibobj(ParserTerm,Object,OidCode,Code,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_prlgterm(Funct,N,Args,Object,OidCode,Code,Status)
	;
	    atomobj_struct(ParserTerm,FObj),
	    N=0,
	    prologterm_struct(FObj,0,[],Object),
	    Code=NULL,
	    OidCode=NULL,
	    Status=[]
	),
	!.


/****************************************************************************
  compile_prologlibobj(+ParserTerm,+Module,-Object,-OidCode,-Code,-Status)

  Compiles Prolog library call @prolog(module) in the arguments position
****************************************************************************/
compile_prologlibobj(ParserTerm,Module,Object,OidCode,Code,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    is_flatom(Funct,FAtom),
	    compile_prlgterm(Funct,N,Args,Object,OidCode,Code,Status)
	;
	    is_flatom(ParserTerm,FAtom),
	    atomobj_struct(ParserTerm,FObj),
	    N=0,
	    prologterm_struct(FObj,0,[],Object),
	    Code=NULL,
	    OidCode=NULL,
	    Status=[]
	),
	!,
	( Status == [] ->
	    %% generate an import statement for the corresponding XSB predicate
	    is_flatom(Module,MName),
	    import_struct(FAtom,N,MName,ICode),
	    directive_struct(ICode,DCode),
	    report_directive(DCode)
	;
	  true
	),
	!.


/****************************************************************************
  compile_prologalllibobj(+ParserTerm,-Object,-OidCode,-Code,-Status)

  Compiles @prologall() in argument position, e.g., foo(f(...)@prologall()
***************************************************************************/
compile_prologalllibobj(ParserTerm,Object,OidCode,Code,Status) :-
	compile_prologlibobj(ParserTerm,PrelimObject,PrelimOidCode,PrelimCode,Status),
	%% PrelimObject is bound and we decompose it
	prologterm_struct(FunctCode,N,ArgsCode,PrelimObject),
	new_varobjlist(N,NewVarList),
	generate_convert_to_prolog_code(ArgsCode,NewVarList,ToPrologCode),
	prologterm_struct(FunctCode,N,NewVarList,Object),
	generate_convert_from_prolog_code(ArgsCode,NewVarList,FromPrologCode),
	conjunct_code([ToPrologCode,PrelimOidCode],OidCode),
	conjunct_code([FromPrologCode,PrelimCode],Code).

/****************************************************************************
  compile_prologalllibobj(+ParserTerm,+Module,-Object,-OidCode,-Code,-Status)

  Compiles @prologall(module) in argument position,
  e.g., foo(f(...)@prologall(module)
***************************************************************************/
compile_prologalllibobj(ParserTerm,Module,Object,OidCode,Code,Status) :-
	compile_prologlibobj(ParserTerm,Module,PrelimObject,PrelimOidCode,PrelimCode,Status),
	%% PrelimObject is bound and we decompose it
	prologterm_struct(FunctCode,N,ArgsCode,PrelimObject),
	new_varobjlist(N,NewVarList),
	generate_convert_to_prolog_code(ArgsCode,NewVarList,ToPrologCode),
	prologterm_struct(FunctCode,N,NewVarList,Object),
	generate_convert_from_prolog_code(ArgsCode,NewVarList,FromPrologCode),
	conjunct_code([ToPrologCode,PrelimOidCode],OidCode),
	conjunct_code([PrelimCode,FromPrologCode],Code).


/****************************************************************************
  compile_prlgterm(+FunctTerm,+Arity,+ArgList,-Object,-OidCode,-Code,-Status)
****************************************************************************/
compile_prlgterm(Funct,N,Args,Object,OidCode,Code,Status) :-
	is_flatom(Funct,FAtom),
	atomobj_struct(Funct,FObj),
	prologterm_struct(FObj,N,AObj,Object),
	( flora_argdef(FAtom,N,ArgTypes) ->
	    compile_argpathexplist(Args,ArgTypes,AObj,OidCode,Code,Status)
	;
	  compile_pathexplist(Args,AObj,OidCode,Code,Status)
	),
	!.


/*************************************************************************
   generate_convert_to_prolog_code(+AObjList,+VarList,-Code)
*************************************************************************/ 
generate_convert_to_prolog_code([],_,NULL).

generate_convert_to_prolog_code([AObjH|AObjT],[VarH|VarT],Code) :-
	atomobj_struct(P2H_PREDICATE,FlP2H),
	%% P2H_DONOT_UNIFY_VARS - do not unify when both arguments are vars
	prologterm_struct(FlP2H,4,[VarH,AObjH,WRAP_HILOG,P2H_DONOT_UNIFY_VARS],CodeH),
	generate_convert_to_prolog_code(AObjT,VarT,CodeT),
	conjunct_code([CodeH,CodeT],Code).

/*************************************************************************
   generate_convert_from_prolog_code(+AObjList,+VarList,-Code)
*************************************************************************/ 
generate_convert_from_prolog_code([],_,NULL).

generate_convert_from_prolog_code([AObjH|AObjT],[VarH|VarT],Code) :-
	atomobj_struct(P2H_PREDICATE,FlP2H),
	%% P2H_UNIFY_VARS - unify when both arguments are vars
	prologterm_struct(FlP2H,4,[VarH,AObjH,WRAP_HILOG,P2H_UNIFY_VARS],CodeH),
	generate_convert_from_prolog_code(AObjT,VarT,CodeT),
	conjunct_code([CodeH,CodeT],Code).
		

/****************************************************************************
  compile_head_wspathexp(+ParserTerm,+Workspace,-Object,-Code,-Status)

  This procedure is called from compile_head_pathexp/5 and
  compile_head_wsflpathexp/6 when a workspace is explicitly specified.
****************************************************************************/
compile_head_wspathexp(ParserTerm,WS,Object,Code,Status) :-
	abort('Compiler - DEPRECATED!!! unreified callable literal in obj pos in the head'),
	( atomlit_struct(HEADLITERAL,ParserTerm,A) ->
	    workspaceobj_struct(A,WS,Object,Code),
	    Status=[]

	; is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_head_wstermobj(Funct,N,Args,WS,Object,Code,Status)

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    compile_head_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,Object,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_head_wsflobjspec(ObjTerm,Spec,WS,Object,Code,Status)
	;
	  is_flobjref(ParserTerm,ObjTerm,RefType,AttTerm),
	  compile_head_wsflobjref(ObjTerm,RefType,AttTerm,WS,Object,Code,Status)
	).


/****************************************************************************
  compile_head_floraliblit(+ParserTerm,+Workspace,-Code,-Status)

  This procedure compiles a head literal associated with a Flora system
  module specification.
****************************************************************************/
compile_head_floraliblit(ParserTerm,WS,Code,Status) :-
	%% Flora system modules are like normal user modules except that
	%% users cannot load files into them
	is_flatom(WS,WSName,Index),
	report_option(FLSYSMOD(WSName),Index),
	atomobj_struct(WSName,Index,WSNameCode),
	floralib_struct(WSNameCode,WSCode),
	compile_head_wsliteral(ParserTerm,WSCode,Code,Status).


/****************************************************************************
  compile_head_wsliteral(+ParserTerm,+Workspace,-Code,-Status)
****************************************************************************/
compile_head_wsliteral(ParserTerm,WS,Code,Status) :-
	( is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_head_wstermlit(Funct,N,Args,WS,Code,Status)

	; is_flbirelate(ParserTerm,ObjTerm1,RelType,ObjTerm2) ->
	    compile_head_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,_Obj,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_head_wsflobjspec(ObjTerm,Spec,WS,_Obj,Code,Status)

	; is_flobjeql(ParserTerm,O1,O2) ->
	    compile_head_wsflobjeql(O1,O2,WS,Code,Status)

        ; is_flvar(ParserTerm,VarName,Index) ->
	    %% Is this possible? Should be taken care by the libmodlit code
	    attach_workspace(WS,
			     compile_flvar(VarName,Index,VarCode),
			     VarCode,Code),
            Status=[]
	;
	    attach_workspace(WS,
			     atomlit_struct(HEADLITERAL,ParserTerm,ACode),
			     ACode,Code),
	  Status=[]
	).


/****************************************************************************
  compile_head_wsflargpathexplist(+ParserTermList,+ArgTypeList,+WS,
                                  -ObjectList,-Code,-Status)
  NOTE: This functionality is not exposed to the user.
        Exists for findall, call, and get_residual (see flrarguments.P)
****************************************************************************/
compile_head_wsflargpathexplist([],[],_WS,[],NULL,[]) :- !.

compile_head_wsflargpathexplist([T|L],[FL_OID|ArgTypeList],WS,
                                [TObj|LObj],Code,Status) :-
	!,
	compile_head_wsflpathexp(T,WS,TObj,TCode,S),
	( S == [] ->
	    compile_head_wsflargpathexplist(L,ArgTypeList,WS,LObj,LCode,Status),
	    (Status == [] -> conjunct_struct(TCode,LCode,Code); true)
	;
	  Status=S
        ).

compile_head_wsflargpathexplist([T|L],[FL_BODYFORMULA|ArgTypeList],WS,
                                [TCode|LObj],Code,Status) :-
	!,
	%% workspace not distributive over nested `meta' argument spec
	%%compile_body(T,TCode,S),
	set_context(goal_reification),
	compile_body(T,TCode1,S),
	reify_struct(TCode1,TCode),
	clear_context(goal_reification),
	( S == [] ->
	    compile_head_wsflargpathexplist(L,ArgTypeList,WS,LObj,Code,Status)
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_wsflpathexplist(+ParserTermList,+WS,-ObjectList,-Code,-Status)
****************************************************************************/
compile_head_wsflpathexplist([],_WS,[],NULL,[]) :- !.

compile_head_wsflpathexplist([T|L],WS,[TObj|LObj],Code,Status) :-
	compile_head_wsflpathexp(T,WS,TObj,TCode,S),
	( S == [] ->
	    compile_head_wsflpathexplist(L,WS,LObj,LCode,Status),
	    (Status == [] -> conjunct_struct(TCode,LCode,Code); true)
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_wsflpathexp(+ParserTerm,+WS,-Object,-Code,-Status)

  Note: The difference between compile_head_wsflpathexp and
        compile_head_wspathexp is that compile_head_wsflpathexp
	applies workspace only to F-Logic constructs.
****************************************************************************/
compile_head_wsflpathexp(ParserTerm,WS,Object,Code,Status) :-
	( is_flbirelate(ParserTerm,OT1,RelType,OT2) ->
	    compile_head_wsflbirelate(OT1,RelType,OT2,WS,Object,Code,Status)

	; is_flobjspec(ParserTerm,ObjTerm,Spec) ->
	    compile_head_wsflobjspec(ObjTerm,Spec,WS,Object,Code,Status)

	; is_flobjref(ParserTerm,ObjTerm,RefType,AttTerm) ->
	    compile_head_wsflobjref(ObjTerm,RefType,AttTerm,WS,Object,Code,Status)

	; is_flterm(ParserTerm,Funct,N,Args) ->
	    compile_head_wsfltermobj(Funct,N,Args,WS,Object,Code,Status)

	; is_fllist(ParserTerm,L,T,I) ->
	    compile_head_wsfllist(L,T,I,WS,Object,Code,Status)

	; is_flworkspace(ParserTerm,P,NestedWS) ->
	    compile_head_wspathexp(P,NestedWS,Object,Code,Status)
	;
	  compile_head_pathexp(ParserTerm,Object,Code,Status)
        ).


/****************************************************************************
  compile_head_wstermobj(+FunctorTerm,+Arity,+ArgList,+WS,-Object,-Code,-Status)
****************************************************************************/
compile_head_wstermobj(_Funct,_N,_Args,WS,_Object,_Code,Status) :-
	is_flvar(WS,_Name,VarIndex),
	!,
	%% Workspace in the rule head is not bound at compile time. Currently
	%% this will generate an error. However, this might be solved by moving
	%% the code that generates the workspace predicate to the body
	%% of the rule.
	compiling_error(VarIndex,VARWSINHEAD,Status).

compile_head_wstermobj(Funct,N,Args,WS,Object,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_head_wsflargpathexplist(Args,ArgTypes,WS,AObj,Code,Status),
	( Status == [] ->
	    termlit_struct(HEADLITERAL,FObj,N,AObj,O),
	    %% WCode should be NULL here since it is already checked
	    %% by the rule that the workspace is not a variable.
	    workspaceobj_struct(O,WS,Object,_WCodeIsNULL)
	;
	  true
	).

compile_head_wstermobj(Funct,N,Args,WS,Object,Code,Status) :-
	compile_head_wsflpathexplist([Funct|Args],WS,[FObj|AObj],Code,Status),
	( Status == [] ->
	    termlit_struct(HEADLITERAL,FObj,N,AObj,O),
	    %% WCode should be NULL here since it is already checked by the rule
	    %% that the workspace is not a variable.
	    workspaceobj_struct(O,WS,Object,_WCodeIsNULL)
	;
	  true
        ).


/****************************************************************************
  compile_head_wsfltermobj(+FunctorTerm,+Arity,+ArgList,+WS,-Object,-Code,-Status)

  Note: The difference between compile_head_wsflpathexp
        and compile_head_wspathexp
        is that compile_head_wsflpathexp applies workspace only to F-Logic
        constructs.
****************************************************************************/
compile_head_wsfltermobj(Funct,N,Args,WS,Object,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_head_wsflargpathexplist(Args,ArgTypes,WS,AObj,Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).

compile_head_wsfltermobj(Funct,N,Args,WS,Object,Code,Status) :-
	compile_head_wsflpathexplist([Funct|Args],WS,[FObj|AObj],Code,Status),
	(Status == [] -> termobj_struct(FObj,N,AObj,Object); true).


/****************************************************************************
  compile_head_wstermlit(+FunctorTerm,+Arity,+ArgList,+WS,-Code,-Status)
****************************************************************************/
compile_head_wstermlit(Funct,N,Args,WS,Code,Status) :-
	is_flatom(Funct,FAtom),
	flora_argdef(FAtom,N,ArgTypes),
	!,
	atomobj_struct(Funct,FObj),
	compile_head_wsflargpathexplist(Args,ArgTypes,WS,AObj,ObjCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     termlit_struct(HEADLITERAL,FObj,N,AObj,TCode),
			     TCode,WSCode),
	    conjunct_struct(ObjCode,WSCode,Code)
	;
	  true
        ).

compile_head_wstermlit(Funct,N,Args,WS,Code,Status) :-
	compile_head_wsflpathexplist([Funct|Args],WS,[FObj|AObj],ObjCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     termlit_struct(HEADLITERAL,FObj,N,AObj,TObj),
			     TObj,WSTObj),
	    conjunct_struct(ObjCode,WSTObj,Code)
	;
	  true
        ).



/****************************************************************************
  compile_head_wsfllist(+ObjTermList,+ObjTerm,+Index,+WS,-Object,-Code,-Status)
****************************************************************************/
compile_head_wsfllist(ObjTermList,ObjTerm,Index,WS,Object,Code,Status) :-
	compile_head_wsflpathexplist(ObjTermList,WS,ObjList,ObjListCode,S),
	( S == [] ->
	    ( ObjTerm == [] ->
		Obj=[],
		ObjCode=NULL,
		Status=[]
	    ;
	      compile_head_wsflpathexp(ObjTerm,WS,Obj,ObjCode,Status)
	    ),
	    ( Status == [] ->
		list_struct(ObjList,Obj,Index,Object),
		conjunct_struct(ObjListCode,ObjCode,Code)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_wsflobjref(+ObjT,+RefType,+AttT,+WS,-Object,-Code,-Status)
****************************************************************************/
compile_head_wsflobjref(ObjTerm,RefType,AttTerm,WS,Object,Code,Status) :-
	compile_head_wsflpathexplist([ObjTerm,AttTerm],WS,[Obj,Att],OACode,Status),
	( Status == [] ->
	    %% Approximate the textual information for the new variable.
	    approximate_index(AttTerm,Index),
	    attach_workspace(WS,
			     head_objref_struct(Obj,RefType,Att,Index,Object,TCode),
			     TCode,WTCode),
	    conjunct_struct(OACode,WTCode,Code)
	;
	  true
        ).


/****************************************************************************
  compile_head_wsflbirelate(+OT1,+RelType,+OT2,+WS,-Object,-Code,-Status)
****************************************************************************/
compile_head_wsflbirelate(ObjTerm1,RelType,ObjTerm2,WS,Obj1,Code,Status) :-
	compile_head_wsflpathexplist([ObjTerm1,ObjTerm2],WS,[Obj1,Obj2],OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     birelate_struct(HEADLITERAL,Obj1,RelType,Obj2,TCode),
			     TCode,WTCode),
	    conjunct_struct(OCode,WTCode,Code)
	;
	  true
        ).


/****************************************************************************
  compile_head_wsflobjspec(+ObjTerm,+SpecBody,+WS,-Object,-Code,-Status)
****************************************************************************/
compile_head_wsflobjspec(ObjTerm,SpecBody,WS,Object,Code,Status) :-
	( SpecBody == [] ->
	    ( is_flobjref(ObjTerm,OTerm,RefType,ATerm) ->
		compile_head_wsflobjref(OTerm,RefType,ATerm,WS,Object,Code,Status)
	    ;
	      compile_head_wsflpathexp(ObjTerm,WS,Object,ObjCode,Status),
	      ( Status == [] ->
		  attach_workspace(WS,
				   objexists_struct(HEADLITERAL,Object,ECode),
				   ECode,WSECode),
		  conjunct_struct(ObjCode,WSECode,Code)
	      ;
	        true
	      )
	    )
	;
	  compile_head_wsflpathexp(ObjTerm,WS,Object,ObjCode,S),
	  ( S == [] ->
	      compile_head_wsflspecbody(Object,SpecBody,WS,SCode,Status),
	      (Status == [] -> conjunct_struct(ObjCode,SCode,Code); true)
	  ;
	    Status=S
	  )
        ).


/****************************************************************************
  compile_head_wsflspecbody(+Object,+SpecTerm,+WS,-Code,-Status)
  compile_head_wsmvdattspec(+Object,+AttObj,+RefType,+VL,+WS,-Code,-Status)
****************************************************************************/
compile_head_wsflspecbody(Object,SpecTerm,WS,Code,Status) :-
	is_flconjunct(SpecTerm,L,R),
	!,
	compile_head_wsflspecbody(Object,L,WS,LCode,S),
	( S == [] ->
	    compile_head_wsflspecbody(Object,R,WS,RCode,Status),
	    (Status == [] -> conjunct_struct(LCode,RCode,Code); true)
	;
	  Status=S
        ).

compile_head_wsflspecbody(Object,SpecTerm,WS,Code,Status) :-
	is_flfdattspec(SpecTerm,AttTerm,RefType,ValTerm),
	!,
	compile_head_wsflpathexplist([AttTerm,ValTerm],WS,[AttObj,ValObj],VACode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     fdattspec_struct(HEADLITERAL,Object,AttObj,RefType,ValObj,SCode),
			     SCode,WSSCode),
	    conjunct_struct(VACode,WSSCode,Code)
	;
	  true
        ).

compile_head_wsflspecbody(Object,SpecTerm,WS,Code,Status) :-
	is_flmvdattspec(SpecTerm,AttTerm,RefType,VL),
	!,
	compile_head_wsflpathexp(AttTerm,WS,AObj,ACode,S),
	( S == [] ->
	    ( VL == [] ->
		attach_workspace(WS,
				 mvdattdef_struct(HEADLITERAL,Object,AObj,RefType,SCode),
				 SCode,WSSCode),
		conjunct_struct(ACode,WSSCode,Code),
		Status=[]
	    ;
	      compile_head_wsmvdattspec(Object,AObj,RefType,VL,WS,VCode,Status),
	      (Status == [] -> conjunct_struct(ACode,VCode,Code); true)
	    )
        ;
	  Status=S
        ).

compile_head_wsflspecbody(Object,SpecTerm,WS,Code,Status) :-
	is_flmethspec(SpecTerm,MethTerm),
	!,
	compile_head_wsflpathexp(MethTerm,WS,MethObj,MCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     methspec_struct(HEADLITERAL,Object,MethObj,SCode),
			     SCode,WSSCode),
	    conjunct_struct(MCode,WSSCode,Code)
	;
	  true
        ).

compile_head_wsflspecbody(Object,SpecTerm,WS,Code,Status) :-
	is_flimethspec(SpecTerm,IMethTerm),
	!,
	compile_head_wsflpathexp(IMethTerm,WS,IMethObj,IMCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     imethspec_struct(HEADLITERAL,Object,IMethObj,SCode),
			     SCode,WSSCode),
	    conjunct_struct(IMCode,WSSCode,Code)
	;
	  true
        ).

compile_head_wsflspecbody(Object,SpecTerm,WS,Code,Status) :-
	is_fltranspec(SpecTerm,TranTerm),
	!,
	compile_head_wsflpathexp(TranTerm,WS,TranObj,TCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     transpec_struct(HEADLITERAL,Object,TranObj,SCode),
			     SCode,WSSCode),
	    conjunct_struct(TCode,WSSCode,Code)
	;
	  true
        ).


compile_head_wsmvdattspec(_Object,_AttObj,_RefType,[],_WS,NULL,[]) :- !.

compile_head_wsmvdattspec(Object,AttObj,RefType,[T|L],WS,Code,Status) :-
	!,
	compile_head_wsflpathexp(T,WS,TObj,TCode,S),
	( S == [] ->
	    attach_workspace(WS,
			     mvdattspec_struct(HEADLITERAL,Object,AttObj,RefType,TObj,SCode),
			     SCode,WSSCode),
	    conjunct_struct(TCode,WSSCode,TSCode),
	    compile_head_wsmvdattspec(Object,AttObj,RefType,L,WS,LCode,Status),
	    (Status == [] -> conjunct_struct(TSCode,LCode,Code); true)
	;
	  Status=S
        ).


/****************************************************************************
  compile_head_wsflobjeql(+Obj1,+Obj2,+Workspace,-Code,-Status)
****************************************************************************/
compile_head_wsflobjeql(Obj1,Obj2,WS,Code,Status) :-
	compile_head_wsflpathexplist([Obj1,Obj2],WS,[O1,O2],OCode,Status),
	( Status == [] ->
	    attach_workspace(WS,
			     objeql_struct(HEADLITERAL,O1,O2,OECode),
			     OECode,WSCode),
	    conjunct_struct(OCode,WSCode,Code)
	;
	  true
	).


/****************************************************************************
  compile_flinsert(+Op,+List,+Cond,-Code,-Status)
****************************************************************************/
compile_flinsert(Op,List,Cond,Code,Status) :-
	compile_flinsert_literals(List,CodeList,S),
	( S == [] ->
	    compile_body(Cond,CondCode,Status),
	    ( Status == [] ->
		list_struct(CodeList,[],ListCode),
		insert_struct(Op,ListCode,CondCode,Code)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_flinsert(+Op,+List,-Code,Status)
****************************************************************************/
compile_flinsert(Op,List,Code,Status) :-
	compile_flinsert_literals(List,CodeList,Status),
	( Status == [] ->
	    list_struct(CodeList,[],ListCode),
	    insert_struct(Op,ListCode,Code)
	;
	  true
        ).


/****************************************************************************
  compile_flinsert_literals(+List,-DBCodeList,-Status)
****************************************************************************/
compile_flinsert_literals(List,DBCodeList,Status) :-
	compile_flinsert_list(List,Code,Status),
	compile_conjunct2list(Code,CodeList),
	(Status == [] -> compile_dbupdate_list(CodeList,DBCodeList); true).


/****************************************************************************
  compile_flinsert_list(+List,-Code,-Status)

  Code is the conjunctions of atoms to be inserted.
****************************************************************************/
compile_flinsert_list([],NULL,[]) :- !.

/*
compile_flinsert_list([H|T],Code,Status) :-
	is_flvar(H,VarName,Index),
	!,
	compile_flvar(VarName,Index,VarCode),
	compile_flinsert_list(T,TCode,Status),
	conjunct_struct(VarCode,TCode,Code).
*/

compile_flinsert_list([H|T],Code,Status) :-
	%% Call compile_head_literal because path expressions should
	%% be skolemized.
	compile_head_literal(H,HCode,S),
	( S == [] ->
	    compile_flinsert_list(T,TCode,Status),
	    (Status == [] -> conjunct_struct(HCode,TCode,Code); true)
	;
	  Status=S
	).


/****************************************************************************
  compile_fldelete(+Op,+List,+Cond,-Code,-Status)

  for delete operations with a condition.
****************************************************************************/
compile_fldelete(Op,List,Cond,Code,Status) :-
	compile_fldelete_literals(List,CodeList,S),
	( S == [] ->
	    compile_body(Cond,CondCode,Status),
	    ( Status == [] ->
		list_struct(CodeList,[],ListCode),
		delete_struct(Op,ListCode,CondCode,Code)
	    ;
	      true
	    )
	;
	  Status=S
        ).


/****************************************************************************
  compile_fldelete(+Op,+List,-Code,-Status)

  for delete operations without a condition.
****************************************************************************/
compile_fldelete(Op,List,Code,Status) :-
	compile_fldelete_literals(List,CodeList,Status),
	( Status == [] ->
	    list_struct(CodeList,[],ListCode),
	    delete_struct(Op,ListCode,Code)
	;
	  true
        ).


/****************************************************************************
  compile_fldelete_literals(+List,-DBCodeList,-Status)
****************************************************************************/
compile_fldelete_literals(List,DBCodeList,Status) :-
	compile_fldelete_list(List,CodeList,Status),
	(Status == [] -> compile_dbupdate_list(CodeList,DBCodeList); true).


/****************************************************************************
  compile_fldelete_list(+List,-CodeList,-Status)
****************************************************************************/
compile_fldelete_list([],[],[]) :- !.

/*
compile_fldelete_list([H|T],[VarCode|TCodeList],Status) :-
	is_flvar(H,VarName,Index),
	!,
	compile_flvar(VarName,Index,VarCode),
	compile_fldelete_list(T,TCodeList,Status).
*/

compile_fldelete_list([H|T],CodeList,Status) :-
	%% When delete list contains an object equality definition, the compiler
	%% will prepare to load the basic equality trailer, unless it is
	%% overridden by an explicity directive.
	is_flobjeql(H,O1,O2),
	!,
	compile_flobjeql(O1,O2,OidCode,SpecCode,S),
	conjunct_code([OidCode,SpecCode],HCode),
	approximate_index(O1,Idx),
	report_option(FLOBJEQLDEF,Idx),
	( S == [] ->
	    compile_conjunct2list(HCode,HCodeList),
	    compile_fldelete_list(T,TCodeList,Status),
	    (Status == [] -> append(HCodeList,TCodeList,CodeList); true)
	;
	  Status=S
        ).

compile_fldelete_list([H|T],CodeList,Status) :-
	%% Call compile_body_literal because path expressions should be
	%% compiled into queries.
	compile_body_literal(H,HCode,S),
	( S == [] ->
	    compile_conjunct2list(HCode,HCodeList),
	    compile_fldelete_list(T,TCodeList,Status),
	    (Status == [] -> append(HCodeList,TCodeList,CodeList); true)
	;
	  Status=S
        ).


/****************************************************************************
  compile_dbupdate_list(+CodeList,-DBCodeList)

  This predicate processes the list of literals in a DB update. For each
  literal, it tries to add the name of the storage trie for the module.

  Note: a DB update can only update a Flora user module or itself. If a
        Flora system module allows update, it must provide an update interface.
****************************************************************************/
compile_dbupdate_list([],[]) :- !.

compile_dbupdate_list([C|CL],[C|DBCodeList]) :-
	( is_varobj_struct(C)
        ; is_florasyslib_struct(C,_,_,_,_)
	),
	!,
	compile_dbupdate_list(CL,DBCodeList).

compile_dbupdate_list([C|CL],[DBCode|DBCodeList]) :-
	( workspace_struct(_P,WS,C) ->
	    %% The name of the module is known.
	    storage_struct(WS,SCode)
	;
	    thisstorage_struct(fdb,SCode),
	    thismodule_struct(WS)
	),
	atomobj_struct(FLSYSDBUPDATE,FCode),
	prologterm_struct(FCode,3,[C,SCode,WS],DBCode),
	compile_dbupdate_list(CL,DBCodeList).

/****************************************************************************
  compile_flupdatetrule(+Op,+List,-Code,-Status)
****************************************************************************/
compile_flupdaterule(Op,List,Code,Status) :-
	is_flatom(Op,OpAtom,Index),
	compile_fldynrule_list(OpAtom,List,CodeList,Status),
	( Status == [] ->
	    list_struct(CodeList,[],ListCode),
	    updaterule_syslib(OpAtom,UpdateruleLib),
	    florasyslib_struct(Index,UpdateruleLib,1,[ListCode],Code)
	;
	    true
        ).

%% compile_fldynrule_list(+Op,+RuleList,-RuleListCode,-Status)
compile_fldynrule_list(_Op,[],[],[]) :- !.
compile_fldynrule_list(Op,[H|L],[HCode|LCode],Status) :-
	compile_fldynrule(Op,H,HCode,S),
	(S == [] -> compile_fldynrule_list(Op,L,LCode,Status)
	; S = Status
	).

%% compile single dynamic rule
%% compile_fldynrule(+Op,+R,-RCode,-Status)
compile_fldynrule(Op,R,RCode,Status) :-
	is_flruleworkspace(R,Rule,WS),
	!,
	workspaceterm_struct(WS,WSTerm),
	set_context(ruleworkspace(WSTerm)),
	compile_fldynrule(Op,Rule,RCode,Status),
	clear_context(ruleworkspace(_)).

compile_fldynrule(_Op,R,RCode,Status) :-
	is_flvar(R,Name,Index),
	varobj_struct(Name,Index,RCode),
	Status=[].

compile_fldynrule(Op,R,RCode,Status) :-
	is_fldynrule(R,Head,Body),
        set_context(compile_with_var_module),
	compile_head(Head,HeadCode,HS),
	compile_conjunct2list(HeadCode,HeadCodeListPre),
	remove_empty_list(HeadCodeListPre,HeadCodeList),
	( HS == [] ->
	    compile_body(Body,BodyCode,Status),
	    (Status==[] ->
	        list_struct(HeadCodeList,[],HCL),
		dynrule_struct(HCL,BodyCode,RCode),
                (is_fldeleteruleop(Op) ->
                    true
                ;
                    check_vars(Head,Body,VarWarns),
                    %% successive compilation depends on Status==[],
                    %% singleton/unbound warnings can not be put in Status
                    assert(dynrule_warnings(VarWarns))
                )
	    ; true
	    )
	;
	    Status=HS
	),
        clear_context(compile_with_var_module).

remove_empty_list([],[]) :- !.
remove_empty_list([[]|L],NL) :- 
	!,
	remove_empty_list(L,NL).
remove_empty_list([H|L],[H|NL]) :- 
	remove_empty_list(L,NL).


/****************************************************************************
             Table maintenance predicates
     refresh{...} removes the corresponding calls from Prolog tables.
****************************************************************************/
compile_flrefresh(List,Code,Status) :-
	compile_fldelete_list(List,CodeList,Status),
	( Status == [] ->
	    list_struct(CodeList,[],ListCode),
	    table_refresh_struct(ListCode,Code)
	;
	  true
        ).

/****************************************************************************
  compile_flclause(+Mode,+HeadList,+Body,-Code,-Status)
****************************************************************************/
compile_flclause(Mode,HeadList,Body,Code,Status) :-
        (Mode==NULL ->
            ModeCode=Mode
        ;
            compile_flatomvar(Mode,ModeCode)
        ),
        set_context(compile_with_var_module),
        compile_fldelete_list(HeadList,HLC,S),
        ( S== [] ->
            list_struct(HLC,[],HeadListCode),
            compile_body(Body,BodyCode,Status),
            ( Status == [] ->
                clause_struct(ModeCode,HeadListCode,BodyCode,Code)
            ;
                true
            )
        ;
            Status = S
        ),
        clear_context(compile_with_var_module).


/****************************************************************************
             Error handling
     catch{Goal,Err,Handler}
****************************************************************************/
compile_flcatch(Goal,Err,Handler,Code,Status) :-
	compile_body(Goal,GoalCode,GoalStatus),
	( GoalStatus == [] ->
	    compile_pathexp(Err,ErrCode,_OidCode,_ObjSpec,ErrStatus),
	    ( ErrStatus == [] ->
		compile_body(Handler,HandlerCode,Status),
		( Status == [] ->
		    catch_struct(GoalCode,ErrCode,HandlerCode,Code)
		; true
		)
	    ; Status = ErrStatus
	    )
	; Status = GoalStatus
	).

/****************************************************************************
     throw{Err}
****************************************************************************/
compile_flthrow(Err,Code,Status) :-
	compile_pathexp(Err,ErrCode,_OidCode,_ObjSpec,Status),
	( Status == [] ->
	    throw_struct(ErrCode,Code)
	; true
	).


/****************************************************************************
     p2h{Prolog,Hilog}
****************************************************************************/
compile_flp2h(Prolog,Hilog,Code,Status) :-
	compile_pathexp(Prolog,PCode,_POidCode,_PObjSpec,PStatus),
	( PStatus == [] ->
	    compile_pathexp(Hilog,HCode,_HOidCode,_HObjSpec,Status),
	    (Status == [] ->
		p2h_struct(PCode,HCode,Code)
	    ; true
	    )
	; Status = PStatus
	).


/****************************************************************************
  compile_exec_directive(+DirectList,+WS,-Code,-Status)
  compile_execdirect_list(+DirectList,+WS,-DirectCodeList)
****************************************************************************/
compile_exec_directive(DirectList,WS,Code,[]) :-
	compile_execdirect_list(DirectList,WS,DirectCodeList),
	conjunct_code(DirectCodeList,Code).


compile_execdirect_list([],_,[]) :- !.

compile_execdirect_list([D|L],WS,[DCode|LCode]) :-
	compile_execdirect(D,WS,DCode),
	compile_execdirect_list(L,WS,LCode).


/****************************************************************************
  compile_execdirect(+Direct,+WS,-Code)
****************************************************************************/
compile_execdirect(DirectTerm,_WS,Code) :-
        %%to compile the export directive
	is_flexport_list(DirectTerm,Term),
        !,
	compile_export(Term,Code).

compile_execdirect(DirectTerm,WS,Code) :-
	(WS == NULL -> thismodule_struct(Mod)
	; compile_flatomvar(WS,Mod)
	),
	( is_flopdef(DirectTerm,Precedence,Associativity,Op) ->
	    florasyslib_struct(FLLIBSHDIRECT,5,[FL_OP,Mod,Precedence,Associativity,Op],Code)
	/** DEPRECATED
	; is_flarguments(DirectTerm,Funct,Arity,Args) ->
	    list_struct(Args,[],ArgsCode),
	    florasyslib_struct(FLLIBSHDIRECT,5,[FL_ARGUMENTS,Mod,Funct,Arity,ArgsCode],Code)
	**/

	; is_flsemantics(DirectTerm,OptionsList) ->
	    is_fllist(OptionsList,L,T,I),
	    %% compile_fllist shouldn't break here: parser checks everything
	    compile_fllist(L,T,I,OptionListCode,_OidCode,_Code,_Status),
	    thismodule_struct(ThisModuleName),
	    florasyslib_struct(FLLIBSEMANTICS,3,[ThisModuleName,OptionListCode,Mod],Code)

	; is_flsetsemantics(DirectTerm,OptionsList) ->
	    is_fllist(OptionsList,L,T,I),
	    %% compile_fllist shouldn't break here: parser checks everything
	    compile_fllist(L,T,I,OptionListCode,_OidCode,_Code,_Status),
	    thismodule_struct(ThisModuleName),
	    florasyslib_struct(FLLIBSETSEMANTICS,3,[ThisModuleName,OptionListCode,Mod],Code)
	
	; is_flindex(DirectTerm,A,P) ->
	    ( is_flterm(A,Funct,1,[NA]) ->
	        atomobj_struct(Funct,FCode),
                (numobj_struct(NA,AC);is_flvar(NA,AN,AI),varobj_struct(AN,AI,AC)),
                prologterm_struct(FCode,1,[AC],ACode)
            ; 
	        (numobj_struct(A,ACode); is_flvar(A,AN,AI),varobj_struct(AN,AI,ACode))
            ),
	    (numobj_struct(P,PCode); is_flvar(P,PN,PI),varobj_struct(PN,PI,PCode)),
            florasyslib_struct(FLLIBSHDIRECT,4,[FL_INDEX,Mod,ACode,PCode],Code)
	),
	!.
