/* File: flrutils.P
**
** Author(s): Guizhen Yang
Michael Kifer
**
** 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: flrutils.P,v 1.106 2003/06/18 07:01:35 kifer Exp $
**
*/
:- compiler_options([xpp_on]).
#include "flag_defs_xsb.h"
#include "standard.h"
#include "flora_characters.flh"
#include "flora_terms.flh"
#include "flora_porting.flh"
#include "flora_extensions.flh"
#include "flora_exceptions.flh"
#define FLORA_FAILURE failure
#define FLORA_SUCCESS success
#define FLORA_NOOP noop
#define FLORA_ALL all
#define FLORA_FILE file
#define FLORA_COMMANDLINE commandline
?- bootstrap_flora.
/*************************************************************************
flora_compile_internal(+File)
*************************************************************************/
flora_compile_internal(File) :-
flora_compile_internal(File,FLORA_DEFAULT_WORKSPACE).
/******************************************************************************
flora_compile_internal(+File,+Workspace)
The OBJ file is renamed using the module name
******************************************************************************/
flora_compile_internal(File,Workspace) :-
flora_check_filename(File),
flora_check_workspace(Workspace),
( flora_locate_file(File,FLORA_FILE_EXT,FlrFile) ->
flora_flcompile(FlrFile,Workspace)
;
flora_flrfilename_error(File),
!,
fail
),
!.
/**********************************************************************
flora_load_module_internal(+File,+Workspace)
File must be a FLORA file.
**********************************************************************/
flora_load_module_internal(InFile,Workspace) :-
flora_check_filename(InFile),
flora_check_workspace(Workspace),
flora_get_user_program_maybe(InFile,File),
( flora_locate_file(File,FLORA_FILE_EXT,FlrFile) ->
flora_flload(FlrFile,Workspace)
;
flora_flrfilename_error(InFile),
!,
fail
),
!.
/**********************************************************************
flora_load_module_internal(+File)
File may be a FLORA file, Prolog file, or OBJ file.
**********************************************************************/
flora_load_module_internal(InFile) :-
flora_check_filename(InFile),
flora_get_user_program_maybe(InFile,File),
( flora_locate_file(File,FLORA_FILE_EXT,FlrFile) ->
flora_flload(FlrFile,FLORA_DEFAULT_WORKSPACE)
; flora_locate_file(File,PROLOG_PFILE_EXT,PFile) ->
flora_stdmsg_nl,
flora_message_line('Consulting ~w',[PFile]),
%% Note: when the loaded file has prolog extension, we don't know
%% if this is a Prolog module or a FLORA compiled output.
%% So, we just in case arrange the GPP options, but don't rename
%% the .xwam file. Maybe we should use a different extension for
%% the target of FLORA compilation?
flora_set_xpp_options_for_compile(FLORA_DEFAULT_WORKSPACE),
flora_add_xpp_options('-warninglevel 1 '),
consult(PFile),
flora_clear_xpp_options
; flora_locate_file(File,PROLOG_OFILE_EXT,OFile) ->
flora_stdmsg_nl,
flora_message_line('Consulting ~w',[OFile]),
consult(OFile)
; parse_filename(File,_,_,Ext),
Ext \== '', Ext \== PROLOG_OFILE_EXT, Ext \== PROLOG_PFILE_EXT, Ext \== FLORA_FILE_EXT,
flora_file_op(exists,File)
->
flora_stderr_nl,
flora_error_line('~w: Filename extension must be ~w, ~w or ~w',
[File,FLORA_FILE_EXT,PROLOG_PFILE_EXT,PROLOG_OFILE_EXT]),
fail
;
flora_stderr_nl,
flora_error_line('File ~w[.{~w|~w|~w}] does not exist',
[File,FLORA_FILE_EXT,PROLOG_PFILE_EXT,PROLOG_OFILE_EXT]),
fail
),
!.
/**********************************************************************
flloadtrailer(+TrailerName,+Workspace)
TrailerName must be either NONE, or BASIC, or FLOGIC.
**********************************************************************/
flloadtrailer(TrailerName) :-
flloadtrailer(TrailerName,FLORA_DEFAULT_WORKSPACE).
flloadtrailer(TrailerName,Workspace) :-
( TrailerName \== NONE, TrailerName \== BASIC, TrailerName \== FLOGIC ->
flora_error_line('Equality mode can be only ~w, ~w, or ~w',
[NONE,BASIC,FLOGIC]),
fail
;
%% Get the trailer file name in Flora package.
flora_check_workspace(Workspace),
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_trailer_filename(TrailerName,TrailerFileName),
flora_concat_atoms([FloraDir,S,trailer,S,TrailerFileName],
TrailerFullName),
%% Get file names in user dir.
flora_user_flora_dir(UserFloraDir),
flora_concat_atoms([UserFloraDir,S,TrailerFileName],UserTrailerPFile),
flora_mainO_filename(UserTrailerPFile,UserTrailerOFile),
flora_WSO_filename(UserTrailerPFile,Workspace,UserTrailerWSOFile),
%% Copy the main file to user directory.
( flora_file_newerthan(UserTrailerPFile,TrailerFullName) ->
true
;
flora_file_op(copy,TrailerFullName,UserTrailerPFile)
),
( flora_file_newerthan(UserTrailerWSOFile,UserTrailerPFile) ->
true
;
flora_set_xpp_options_for_compile(Workspace),
%%compile(UserTrailerPFile,[optimize,spec_repr,ti_all]),
compile(UserTrailerPFile,[optimize,ti_all]),
flora_rename_file(UserTrailerOFile,UserTrailerWSOFile),
flora_clear_xpp_options
),
consult(UserTrailerWSOFile),
!,
%% Check if the patch needs to be loaded.
%% Patch (.xsb/flora/patch.P) is loaded only once per workspace
%% and only into the flora shell. The flora_module_registry/1 guard
%% ensures this and that patch rules are never loaded into the same
%% module as compiled programs.
(flora_module_registry(Workspace) -> true
; flloadpatch(Workspace)
)
),
!.
/**********************************************************************
flsetuptrailer(+TrailerName)
TrailerName must be either NONE, or BASIC, or FLOGIC.
This predicate is called in the Makefile.
**********************************************************************/
flsetuptrailer(TrailerName) :-
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_trailer_filename(TrailerName,TrailerFileName),
flora_concat_atoms([FloraDir,S,trailer,S,TrailerFileName],TrailerFullName),
telling(PreOutFile),
tell(TrailerFullName),
flora_trailer_include(TrailerName,TrailerInclude),
flora_include_file([FLHEADER,FLHEADER2|TrailerInclude],HeaderStatus),
told,
tell(PreOutFile),
!,
( HeaderStatus == FLORA_FAILURE ->
fail
;
flora_set_xpp_options_for_compile(FLORA_DEFAULT_WORKSPACE),
%%compile(TrailerFullName,[optimize,spec_repr,ti_all]),
compile(TrailerFullName,[optimize,ti_all]),
flora_clear_xpp_options
),
!.
flora_trailer_filename(NONE,'standard.P').
flora_trailer_filename(BASIC,'eqlbasic.P').
flora_trailer_filename(FLOGIC,'eqlflogic.P').
flora_trailer_include(NONE,[FLTRAILER]).
flora_trailer_include(BASIC,[FLEQLTRAILER]).
flora_trailer_include(FLOGIC,[FLEQLTRAILER,FLSCALAREQL]).
/**********************************************************************
flloadpatch(+Workspace)
This is loaded only in the shell and only once per workspace name.
Compiled programs have their patch rules included by the compiler,
and they don't need flloadpatch/1. (In fact, compiled rules and patch
rules clash and should never be loaded into the same workspace.
**********************************************************************/
flloadpatch(Workspace) :-
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_patch_filename(PatchName),
flora_concat_atoms([FloraDir,S,trailer,S,PatchName],PatchFullName),
%% Get file names in user dir.
flora_user_flora_dir(UserFloraDir),
flora_concat_atoms([UserFloraDir,S,PatchName],UserPatchPFile),
flora_mainO_filename(UserPatchPFile,UserPatchOFile),
flora_WSO_filename(UserPatchPFile,Workspace,UserPatchWSOFile),
%% Copy the main file to user directory.
( flora_file_newerthan(UserPatchPFile,PatchFullName) -> true
;
flora_file_op(copy,PatchFullName,UserPatchPFile)
),
( flora_file_newerthan(UserPatchWSOFile,UserPatchPFile) ->
true
;
flora_set_xpp_options_for_compile(Workspace),
%%compile(UserPatchPFile,[optimize,spec_repr,ti_all]),
compile(UserPatchPFile,[optimize,ti_all]),
flora_rename_file(UserPatchOFile,UserPatchWSOFile),
flora_clear_xpp_options
),
consult(UserPatchWSOFile),
!.
/**********************************************************************
flsetuppatch
**********************************************************************/
flsetuppatch :-
flora_patch_full_filename(PatchFullName),
telling(PreOutFile),
tell(PatchFullName),
flora_include_file([FLHEADER,FLDEFINITION,FLHEADER2,FLPATCH,FLDYNA,
FLDYNZ,FLPREDDEF,FLREFRESHTABLE],
HeaderStatus),
told,
tell(PreOutFile),
!,
( HeaderStatus == FLORA_FAILURE ->
fail
;
flora_set_xpp_options_for_compile(FLORA_DEFAULT_WORKSPACE),
%%compile(PatchFullName,[optimize,spec_repr,ti_all]),
compile(PatchFullName,[optimize,ti_all]),
flora_clear_xpp_options
),
!.
flora_patch_full_filename(PatchFullName) :-
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_patch_filename(PatchName),
flora_concat_atoms([FloraDir,S,trailer,S,PatchName],PatchFullName).
flora_patch_filename('patch.P').
/*************************************************************************
flora_user_flora_dir(-Dir)
*************************************************************************/
flora_user_flora_dir(Dir) :-
( flora_configuration(userdir,Dir) ->
true
;
flora_user_home(UserHome),
flora_slash(S),
%% something like $HOME/.xsb/flora
flora_concat_atoms([UserHome,S,PROLOG_CUSTOM_DIR,S,flora],Dir),
( flora_file_op(exists,Dir) -> true
;
( flora_file_op(mkdir,Dir) -> true
;
flora_abort(['Cannot create directory: ',Dir])
)
),
assert(flora_configuration(userdir,Dir))
),
!.
flora_user_tmpfile(Filename) :-
flora_user_flora_dir(Dir),
flora_slash(S),
flora_concat_atoms([Dir,S,'tmp$user'],Filename).
/*************************************************************************
flora_rename_file(+F1,+F2)
This is like flora_file_op(rename,F1,F2), but it issues an error when fails.
The reason is that on Windows files sometimes fail to be renamed for
strange reasons, so we first delete F2, try to rename, and if failed,
issue an error, which explains what happened.
There is no point to continue after a failure, because Flora
will be in a broken state.
*************************************************************************/
flora_rename_file(F1,F2) :-
( (flora_file_op(unlink,F2), !; true),
flora_file_op(rename,F1,F2), !
;
flora_abort(['Something wrong -- cannot rename ',F1,' to ',F2])
).
/*************************************************************************
flora_flcompile(+FlrFile,+ModuleName)
This procedure is called to compile either a Flora user module or a
Flora system module. In the former case, the module name is an atom
whereas in the latter case the module name looks like flora(name).
*************************************************************************/
flora_flcompile(FlrFile,ModuleName) :-
flora_mainP_filename(FlrFile,MPFile),
flora_FDB_filename(FlrFile,FDBFile),
flora_FLD_filename(FlrFile,FLDFile),
flora_set_xpp_options_for_compile(ModuleName),
flora_compile_file(FlrFile,MPFile,FDBFile,FLDFile,Status),
( Status == FLORA_FAILURE ->
flora_clear_xpp_options,
!,
fail
;
flora_mainO_filename(FlrFile,MOFile),
flora_message_line('Calling XSB compiler'),
(
%% Issue only important preprocessor warnings
%% to avoid warnings when atoms or strings have \n in them
flora_set_xpp_options_for_compile(ModuleName),
flora_add_xpp_options('-warninglevel 1 '),
%%compile(MPFile,[optimize,spec_repr,ti_all])
compile(MPFile,[optimize,ti_all]) ->
true
;
flora_clear_xpp_options,
fail
),
!,
flora_clear_xpp_options,
flora_module_name(ModuleName,_Type,Workspace),
flora_WSO_filename(FlrFile,Workspace,WSOFile),
flora_rename_file(MOFile,WSOFile)
),
!.
/******************************************************************************
flora_compile_system_module(+File)
Compile a Flora system module in the lib/ directory. These files are
loaded into predefined modules. This procedure is used only in the Makefile.
Error checking for file name, existence, etc., is omitted.
Note: This predicate is used *ONLY* in the make file for simplicity.
******************************************************************************/
flora_compile_system_module(File) :-
%% Get the system module ID from the base file name.
flora_file_op(basename,File,BaseName),
flora_sysmod_file(SysModID,BaseName,_SubDir),
( flora_locate_file(BaseName,FLORA_FILE_EXT,FlrFile) ->
flora_module_name(ModuleName,systemmodule,SysModID),
flora_flcompile(FlrFile,ModuleName)
;
flora_stderr_nl,
flora_error_line('File ~w[.~w] does not exist',
[BaseName,FLORA_FILE_EXT]),
!,
fail
),
!.
/*************************************************************************
flora_load_system_module_internal(+SysModID)
This predicate is called to load a Flora system module. The input is
its ID.
*************************************************************************/
flora_load_system_module_internal(SysModID) :-
( atom(SysModID), flora_sysmod_file(SysModID,BaseName,SubDir) ->
flora_module_name(ModuleName,systemmodule,SysModID),
%% Compute the Flora file name.
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_concat_atoms([FloraDir,S,SubDir,S,BaseName,'.flr'],FlrFile),
flora_WSO_filename(FlrFile,SysModID,WSOFile),
!,
( flora_file_newerthan(WSOFile,FlrFile) ->
true
; flora_file_op(exists,FlrFile) ->
flora_flcompile(FlrFile,ModuleName)
;
flora_stderr_nl,
flora_error_line('system module file `~w'' does not exist',
[FlrFile]),
!,
fail
),
!,
flora_message_line('loading FLORA system module `~w''',[SysModID]),
%% Issue only important preprocessor warnings
%% to avoid warnings when atoms or strings have \n in them
flora_set_xpp_options_for_compile(ModuleName, '-warninglevel 0 '),
consult(WSOFile),
flora_clear_xpp_options
;
flora_stderr_nl,
flora_error_line('Invalid system module ID ~w -- Loading failed',
[SysModID]),
!,
fail
),
!.
/******************************************************************************
flora_compile_system_module_by_ID(+SysModID)
Compile a Flora system module in the lib/ directory according to its ID.
This is like flora_load_system_module_internal/1 but doesn't load the file
******************************************************************************/
flora_compile_system_module_by_ID(SysModID) :-
%% Retrieve the file name and its subdir.
flora_sysmod_file(SysModID,BaseName,SubDir),
%% Compute the Flora file name.
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_concat_atoms([FloraDir,S,SubDir,S,BaseName,'.flr'],FlrFile),
( flora_file_op(exists,FlrFile) ->
flora_module_name(ModuleName,systemmodule,SysModID),
flora_flcompile(FlrFile,ModuleName)
;
flora_stderr_nl,
flora_error_line('system module file `~w'' does not exist',
[FlrFile]),
!,
fail
),
!.
/*************************************************************************
flora_flload(+FlrFile,+Workspace)
Need to make sure the GPP options are cleared when this procedure is
finished.
*************************************************************************/
flora_flload(FlrFile,Workspace) :-
flora_mainP_filename(FlrFile,MPFile),
flora_mainO_filename(FlrFile,MOFile),
flora_FDB_filename(FlrFile,FDBFile),
%% support for undefinedness
flora_FLD_filename(FlrFile,FLDFile),
flora_WSO_filename(FlrFile,Workspace,WSOFile),
!,
flora_set_xpp_options_for_compile(Workspace),
( flora_file_newerthan(MPFile,FlrFile) ->
flora_stdmsg_nl,
true
;
flora_compile_file(FlrFile,MPFile,FDBFile,FLDFile,Status),
( Status == FLORA_FAILURE ->
flora_clear_xpp_options,
!,
fail
;
true
)
),
!,
flora_message_line('Loading ~w into module ~w',[FlrFile,Workspace]),
( flora_file_newerthan(WSOFile,MPFile) ->
true
;
(
flora_set_xpp_options_for_compile(Workspace),
flora_add_xpp_options('-warninglevel 0 '),
%%compile(MPFile,[optimize,spec_repr,ti_all])
compile(MPFile,[optimize,ti_all])
->
true
;
flora_clear_xpp_options,
fail
),
flora_rename_file(MOFile,WSOFile)
),
consult(WSOFile),
flora_clear_xpp_options,
!.
/*****************************************************************************
flora_save_user_clauses(+FlrFile)
Read user input and save it in the given file
*****************************************************************************/
flora_save_user_clauses(FlrFile) :-
(flora_running_under(windows) -> CtlChar = 'Z' ; CtlChar = 'D'),
flora_message_line('Type in FLORA program statements; Ctl-~w when done',
[CtlChar]),
flora_copy_input(_,FlrFile),
flora_message_line('Program saved in file ~w', [FlrFile]).
/*************************************************************************
flora_get_user_program_maybe(+InFile,-File)
If InFile = user assume the user wants to input the program from the shell.
Retrun the name of the tempfile that has the program.
*************************************************************************/
flora_get_user_program_maybe(InFile,File) :-
( InFile == user ->
%%flora_file_op(tmpfilename,File),
flora_user_tmpfile(File),
flora_concat_atoms([File,'.',FLORA_FILE_EXT],FlrFile),
flora_save_user_clauses(FlrFile)
;
File=InFile
).
/*************************************************************************
flora_locate_file(+InFile,+ExtType,-ExtFile)
InFile must have ExtType as extension or no extension (in this case,
ExtType is appended).
*************************************************************************/
flora_locate_file(InFile,ExtType,ExtFile) :-
parse_filename(InFile,_,_,Ext),
( Ext == ExtType -> ExtFileName=InFile
;
flora_concat_atoms([InFile,'.',ExtType],ExtFileName)
),
flora_locate_file(ExtFileName,ExtFile),
!.
/*************************************************************************
flora_locate_file(+InFile,-LocatedFile)
When it succeeds, it returns the absolute file name.
*************************************************************************/
flora_locate_file(In,In) :-
flora_file_op(isabsolute,In),
!,
flora_file_op(exists,In).
flora_locate_file(In,Loc) :-
flora_module_path_get(LibDir),
flora_slash(S),
flora_concat_atoms([LibDir,S,In],File),
flora_file_op(expand,File,Loc),
flora_file_op(exists,Loc),
!.
/*************************************************************************
flora_file_newerthan(+File1,+File2)
returns true if File1 exists and is newer than File2. File2 already exists.
*************************************************************************/
flora_file_newerthan(File1,File2) :-
flora_file_op(exists,File1),
flora_file_op(newerthan,File1,File2).
/*************************************************************************
flora_mainP_filename(+File,-MPFile)
flora_mainO_filename(+File,-MOFile)
flora_FDB_filename(+File,-FDBFile)
flora_FLD_filename(+File,-FLDFile)
flora_FLH_filename(+File,-FLHFile)
flora_WSO_filename(+File,+WS,-WSOFile)
flora_dump_filename(+File,-DFile)
*************************************************************************/
flora_mainP_filename(File,MPFile) :-
parse_filename(File,Dir,Base,_),
flora_concat_atoms([Dir,Base,'.',PROLOG_PFILE_EXT],MPFile).
flora_mainO_filename(File,MOFile) :-
parse_filename(File,Dir,Base,_),
flora_concat_atoms([Dir,Base,'.',PROLOG_OFILE_EXT],MOFile).
flora_FDB_filename(File,FDBFile) :-
parse_filename(File,Dir,Base,_),
flora_concat_atoms([Dir,Base,'.',FLORA_FDB_EXT],FDBFile).
flora_FLD_filename(File,FLDFile) :-
parse_filename(File,Dir,Base,_),
flora_concat_atoms([Dir,Base,'.',FLORA_FLD_EXT],FLDFile).
flora_FLH_filename(File,FLHFile) :-
parse_filename(File,Dir,Base,_),
flora_concat_atoms([Dir,Base,'.',FLORA_HEADER_EXT],FLHFile).
%% File name for the object file with module name attached
flora_WSO_filename(File,WS,WSOFile) :-
parse_filename(File,Dir,Base,_),
flora_concat_atoms([Dir,Base,'_',WS,'.',PROLOG_OFILE_EXT],WSOFile).
flora_dump_filename(File,DFile) :-
parse_filename(File,Dir,Base,Ext),
flora_concat_atoms([Dir,Base,'_dump.',Ext],DFile).
/*************************************************************************
utilities
*************************************************************************/
flora_check_filename(Name) :-
( not atom(Name) ->
flora_error_line('Invalid file name'),
fail
;
true
).
flora_check_workspace(Name) :-
( var(Name) ->
flora_error_line('Uninstantiated module name'),
fail
; not (atom(Name), is_alphanumeric(Name)) ->
flora_error_heading,
flora_stderr_string('Invalid module name (not alphanumeric): '),
flora_stderr_write(Name),
flora_stderr_nl,
fail
;
true
).
is_alphanumeric(Name) :-
atom_codes(Name,NameL),
is_alphanumericL(NameL).
is_alphanumericChar(Ch) :-
( CH_0 =< Ch, Ch =< CH_9
; CH_a =< Ch, Ch =< CH_z
; CH_A =< Ch, Ch =< CH_Z
; Ch == CH_UNDERSCORE
).
is_alphanumericL([]).
is_alphanumericL([Ch|Rest]) :-
is_alphanumericChar(Ch),
is_alphanumericL(Rest).
/*************************************************************************
gpp control utilities
*************************************************************************/
%% standard gpp options used by Flora.
flora_xpp_standard_options_for_compile('-P -m -nostdinc -curdirinclast -includemarker "'FLORA_GPP_MARKUP'.@'FLORA_GPP_MARKUP'(?,''?'',''?'')."').
flora_xpp_standard_options_for_dump('-P -m -nostdinc -curdirinclast').
flora_xpp_standard_options_for_read('-P -m -nostdinc -curdirinclast').
flora_set_xpp_options_for_compile :- flora_set_xpp_options(compile).
flora_set_xpp_options_for_compile(Module) :- flora_set_xpp_options(compile,Module).
flora_set_xpp_options_for_compile(Module,ExtraOpts) :-
flora_set_xpp_options(compile,Module,ExtraOpts).
%%flora_set_xpp_options_for_dump(Module) :- flora_set_xpp_options(dump,Module).
flora_set_xpp_options_for_dump(Module,ExtraOpts) :-
flora_set_xpp_options(dump,Module,ExtraOpts).
flora_set_xpp_options_for_read :- flora_set_xpp_options(read).
flora_set_xpp_options_for_read(Module) :- flora_set_xpp_options(read,Module).
flora_set_xpp_options_for_read(Module,ExtraOpts) :-
flora_set_xpp_options(read,Module,ExtraOpts).
flora_set_xpp_options(Purpose) :-
retractall(xpp_options(_)),
(Purpose==read -> flora_xpp_standard_options_for_read(StandardOpt)
; Purpose==dump -> flora_xpp_standard_options_for_dump(StandardOpt)
; flora_xpp_standard_options_for_compile(StandardOpt)
),
assert(xpp_options(StandardOpt)).
%% This is always called before invoking GPP.
%% If ModuleName looks like a system module name (flora(_)) then adds
%% extra options for compiling system modules.
%% Note: This predicate should not be called before a previous call of
%% flora_set_xpp_options finishes.
%% Purpose is either read or compile.
flora_set_xpp_options(Purpose,ModuleName) :-
retractall(xpp_options(_)),
flora_module_name(ModuleName,Type,WS),
( Type == usermodule ->
ExtraOpt=''
; Type == systemmodule ->
ExtraOpt='-D FLORA_COMPILE_SYSTEM_MODULE'
; Type == invalid ->
flora_module_name_error(WS)
),
(Purpose==read -> flora_xpp_standard_options_for_read(StandardOpt)
; Purpose==dump -> flora_xpp_standard_options_for_dump(StandardOpt)
; flora_xpp_standard_options_for_compile(StandardOpt)
),
flora_concat_atoms([StandardOpt,' -D FLORA_VAR_WORKSPACE=',WS,
' ',ExtraOpt],
Opt),
assert(xpp_options(Opt)),
!.
%% Purpose is either read or compile
flora_set_xpp_options(Purpose,ModuleName,ExtraOpt) :-
flora_set_xpp_options(Purpose,ModuleName),
flora_add_xpp_options(ExtraOpt).
%% Adds NewOpt to the existing XPP options
flora_add_xpp_options(NewOpt) :-
xpp_options(XOpt),
retractall(xpp_options(_)),
flora_concat_atoms([XOpt,' ',NewOpt],Opt),
assert(xpp_options(Opt)).
flora_clear_xpp_options :-
retractall(xpp_options(_)).
/*************************************************************************
flora_insert_code_for_loaddyn_data(+FileName)
Add static code to the compiled .P file for loading FDB and FLD files.
*************************************************************************/
flora_insert_code_for_loaddyn_data(FileName) :-
%% Output the base file name only. The full path will be taken
%% care of by flora_loaddyn_data and consult.
parse_filename(FileName,_Dir,Base,Ext),
( Ext == FLORA_FDB_EXT, DataCat='FDB'
; Ext == FLORA_FLD_EXT, DataCat='FLD'
),
%% The if-then-else play of FLORA_FDB_FILENAME and FLORA_FLD_FILENAME,
%% controls whether flora_loaddyn_data/3 is used to load dynamic data
%% or directly flora_read_canonical_and_insert/2
%% Normally FLORA_FDB_FILENAME/FLORA_FLD_FILENAME are not defined,
%% so data is loaded using flora_loaddyn_data/3.
%% However, when we are trying to produce a dump of the program (where all
%% the preprocessor stuff is stripped), then we don't need
%% flora_loaddyn_data/3 (whose primary purpose is to invoke the preprocessor
%% before invoking flora_read_canonical_and_insert/2).
%% In this case, we put the .P file through the preprocessor with
%% FLORA_FDB_FILENAME set to ''. The result is that in the dumped
%% program only the call to flora_read_canonical_and_insert/2 will stay.
format("#if !defined(FLORA_~w_FILENAME)",[DataCat]),
nl,
writeln('#if !defined(FLORA_LOADDYN_DATA)'),
writeln('#define FLORA_LOADDYN_DATA'),
writeln(':- import flora_loaddyn_data/3 from flrutils.'),
writeln('#endif'),
format("#define FLORA_~w_FILENAME '~w.~w'", [DataCat,Base,Ext]),
nl,
format("?- flora_loaddyn_data(FLORA_~w_FILENAME,FLORA_THIS_MODULE_NAME,'~w').",[DataCat,Ext]),
nl,
writeln('#else'),
writeln('#if !defined(FLORA_READ_CANONICAL_AND_INSERT)'),
writeln('#define FLORA_READ_CANONICAL_AND_INSERT'),
writeln(':- import flora_read_canonical_and_insert/2 from flrutils.'),
writeln('#endif'),
format("?- flora_read_canonical_and_insert(FLORA_~w_FILENAME,FLORA_THIS_~w_STORAGE).",[DataCat,DataCat]),
nl,
writeln('#endif'),
nl.
/*************************************************************************
flora_include_file(+OptionList,-Status)
*************************************************************************/
flora_include_file([],FLORA_SUCCESS) :- !.
flora_include_file([Opt|OptList],Status) :-
flora_include(Opt,File),
!,
flora_configuration(installdir,FloraDir),
flora_slash(S),
flora_concat_atoms([FloraDir,S,File],FullName),
( flora_file_op(exists,FullName) ->
flora_copy_input(FullName,_),
flora_include_file(OptList,Status)
;
flora_error_line('The FLORA system file ~w cannot be found',
[FullName]),
Status=FLORA_FAILURE
).
flora_include_file(_OptList,FLORA_FAILURE) :-
flora_error_line('System file corrupted').
/*************************************************************************
flora_end_of_input(+Status)
flora_not_end_of_input(+Status)
*************************************************************************/
flora_end_of_input(Status) :- member(FLORA_EOF,Status).
flora_not_end_of_input(Status) :- member(FLORA_NOT_EOF,Status).
/*************************************************************************
flora_reset_modules_for_file(+FullFileName)
*************************************************************************/
flora_reset_modules_for_file(FullFileName) :-
flora_reset_lexer(FullFileName),
flora_reset_composer,
flora_reset_operator,
flora_reset_arguments,
flora_reset_prolog,
flora_reset_hilogtable,
flora_reset_compiler,
flora_set_counter(flora_shell_mode,0),
%% for hilog table
flora_set_counter(flora_rule_number,1),
retractall(flora_compiler_environment(_,_)),
assert(flora_compiler_environment(file,FullFileName)),
!.
/*************************************************************************
flora_reset_modules_for_shell/0
*************************************************************************/
flora_reset_modules_for_shell :-
flora_reset_lexer,
flora_reset_composer,
flora_reset_compiler,
flora_set_counter(flora_shell_mode,1),
retractall(flora_compiler_environment(_,_)),
assert(flora_compiler_environment(file,userin)).
/*************************************************************************
flora_compile_file(+InputFile,+OutputPFile,+OutputDBFile,+OutputFLDFile,-FileStatus)
Note: FileStatus returns either FLORA_FAILURE or FLORA_SUCCESS.
The appropriate GPP options must be set before this procedure is called.
*************************************************************************/
flora_compile_file(InputFile,PFile,DBFile,FLDFile,FileStatus) :-
flora_maxerr(MaxErrNum),
flora_stdmsg_nl,
flora_message_line('Compiling ~w',[InputFile]),
flora_cputime(T0),
seeing(PreInFile),
%% Disable the compilation for FLORA template include file.
flora_set_counter(flora_compile_include_file,0),
flora_reset_modules_for_file(InputFile),
xpp_process_file(InputFile,XPP_process,IOportFromProc),
stat_set_flag(CURRENT_INPUT,IOportFromProc),
flora_measure_time(
flora_rpc_file(MaxErrNum,0,0,CompiledRuleList,
FileOptionList,CompileStatus),
'Compile time '
),
%% Wait, to not leave zombies.
process_control(XPP_process,wait(ExitStatus)),
(ExitStatus==0, !
; flora_error_line('Error while preprocessing ~w', [InputFile])
),
%% Release the file descriptor used to read from cpp.
file_close(IOportFromProc),
see(PreInFile),
( CompileStatus == FLORA_FAILURE ->
FileStatus=FLORA_FAILURE
;
flora_measure_time(
check_for_dependencies(CompiledRuleList,DepWarnList),
'Dependency checking time: '
),
check_for_dependencies_errorwarn(DepWarnList,DepWarnNum,DepErrNum),
flora_errorwarn_count(0,DepWarnNum),
( DepErrNum>0 ->
FileStatus=FLORA_FAILURE
;
flora_generate_file(CompiledRuleList,FileOptionList,
PFile,DBFile,FLDFile,FileStatus)
)
),
flora_cputime(T1),
( FileStatus == FLORA_FAILURE ->
true
;
T is T1-T0,
flora_message_line('Done! CPU time used: ~w seconds',[T])
),
!.
%% Catch a failure situation.
flora_compile_file(_InputFile,_PFile,_DBFile,_FLDFile,FLORA_FAILURE).
/*************************************************************************
flora_generate_file(+CompiledRuleList,+FileOptionList,+PFile,+DBFile,+FLDFile,-FileStatus)
Note: FileStatus returns either FLORA_FAILURE or FLORA_SUCCESS.
*************************************************************************/
flora_generate_file(CompiledRuleList,FileOptionList,PFile,DBFile,FLDFile,FileStatus) :-
%% Generate FLD file for undefinedness checking
flora_debug_code(CompiledRuleList, FLDFile),
flora_divide_program(CompiledRuleList,RuleList,FactList),
sort(FileOptionList,FileOptions),
flora_measure_time(
flora_generate_Pfile(PFile,FileOptions,RuleList,FactList,
DBFile,FLDFile,PFileStatus),
'[Coder] Generating P file'
),
( PFileStatus == FLORA_FAILURE ->
FileStatus=FLORA_FAILURE
;
( FactList == [] ->
FileStatus=FLORA_SUCCESS
;
flora_measure_time(
flora_generate_DBfile(DBFile,FactList,FileStatus),
'[Coder] Generating DB file'
)
)
),
!.
/*************************************************************************
flora_generate_Pfile(+PFileName,+FileOptionList,+RuleList,+FactList,
+DBFile,+FLDFile,-FileStatus)
Things to do:
(1) include .flh file directive.
(2) output header file.
(3) syslib and sysmod loading instrucitons.
(4) DB file loading instruction.
(5) program.
(6) trailer.
*************************************************************************/
flora_generate_Pfile(PFileName,FileOptionList,RuleList,FactList,DBFile,FLDFile,FileStatus) :-
telling(PreOutFile),
tell(PFileName),
findall(LibOption,member(FLSYSLIB(LibOption),FileOptionList),SysLibOptionList),
findall(ModOption,member(FLSYSMOD(ModOption),FileOptionList),SysModOptionList),
append(SysLibOptionList,SysModOptionList,OptList),
( member(XSB_SPECREPR,FileOptionList) -> true
; writeln(':- compiler_options([spec_off]).')),
flora_include_file([FLHEADER,FLHEADER2],FLHeaderStatus),
( FLHeaderStatus == FLORA_FAILURE -> FileStatus=FLORA_FAILURE
;
findall((Arity,Pos),member(FLINDEX(Arity,Pos),FileOptionList),IndexList),
write_index_directives(IndexList),
flora_include_file([FLDEFINITION,FLREFRESHTABLE,FLLIBIMPORTEDCALLS,
FLINDEX_P,FLPATCH,FLDYNA|OptList],
HeaderStatus),
( HeaderStatus == FLORA_FAILURE -> FileStatus=FLORA_FAILURE
;
(FactList == [] -> true; flora_insert_code_for_loaddyn_data(DBFile)),
flora_insert_code_for_loaddyn_data(FLDFile),
%% Generate entries for tabled or non-tabled predicate registries
flora_table_info(RuleList),
flora_extern_code(RuleList,CoderStatus),
( CoderStatus == [] ->
( member(FLEQLFLOGIC,FileOptionList) ->
%% A directive in the program specifies the full equality trailer.
%% This option adds FLSCALAREQL, which handles the equality
%% implied by single-valued methods.
flora_message_line('Including full F-logic equality maintenance'),
flora_include_file([FLEQLTRAILER,FLSCALAREQL],FileStatus)
; member(FLEQLBASIC,FileOptionList) ->
%% The basic equality trailer does not include the equality
%% implied by single-valued methods.
flora_message_line('Including basic equality maintenance'),
flora_include_file([FLEQLTRAILER],FileStatus)
; member(FLEQLNONE,FileOptionList) ->
%% Explicit directive takes precedence over any default.
flora_message_line('Excluding equality maintenance'),
flora_include_file([FLTRAILER],FileStatus)
; member(FLOBJEQLDEF,FileOptionList) ->
flora_message_line('Including basic equality maintenance'),
flora_include_file([FLEQLTRAILER],FileStatus)
;
%% By default no equality is included.
flora_include_file([FLTRAILER],FileStatus)
),
flora_include_file([FLDYNZ,FLPREDDEF],FileStatus)
;
flora_coder_error(CoderStatus),
FileStatus=FLORA_FAILURE
)
)
),
told,
tell(PreOutFile),
!.
/*************************************************************************
write_index_directives(+IndexList)
For every pair (A,P) in the list, generate code (assuming A+1=A1,P+1=P1)
:- index flapply/A1-P1.
?- index(dyna_flapply/A1,P1).
?- index(dynz_flapply/A1,P1).
*************************************************************************/
write_index_directives([]) :- !.
write_index_directives([(A,P)|L]) :-
A1 is A+1, P1 is P+1,
flora_write_atom(':- index FLORA_THIS_WORKSPACE('),
flora_write_atom(WRAP_HILOG), flora_write_atom(')/'),
write(A1), put(0'-), write(P1), put(0'.), nl,
flora_write_atom('?- index(FLORA_THIS_WORKSPACE('),
flora_write_atom(WRAP_DYNA_HILOG), flora_write_atom(')/'),
write(A1), put(0',), write(P1), put(0')),put(0'.), nl,
flora_write_atom('?- index(FLORA_THIS_WORKSPACE('),
flora_write_atom(WRAP_DYNZ_HILOG), flora_write_atom(')/'),
write(A1), put(0',), write(P1), put(0')),put(0'.), nl,
write_index_directives(L).
/*************************************************************************
flora_generate_DBfile(+DBFileName,+FactList,-FileStatus)
Things to do:
(1) include .flh file directive.
(2) output header file.
(3) facts.
*************************************************************************/
flora_generate_DBfile(DBFileName,FactList,FileStatus) :-
telling(PreOutFile),
tell(DBFileName),
%% Include Macro definitions.
writeln('#include "flrheader.flh"'),
nl,
flora_extern_code(FactList,CoderStatus),
( CoderStatus == [] ->
FileStatus=FLORA_SUCCESS
;
flora_coder_error(CoderStatus),
FileStatus=FLORA_FAILURE
),
told,
tell(PreOutFile),
!.
/* This version preprocesses the DB file as much as possible, leaving
FLORA_VAR_WORKSPACE only. Unfortunately, it occurs between quotes
and is not expanded.
:- import file_write/2, file_nl/2 from xsb_writ.
flora_set_xpp_options_for_dump :- flora_set_xpp_options(dump).
flora_generate_DBfile(DBFileName,FactList,FileStatus) :-
telling(PreOutFile),
flora_set_xpp_options_for_dump,
file_open(DBFileName,w,DBFilePort),
file_write(DBFilePort,'#mode save'), file_nl(DBFilePort),
file_write(DBFilePort,'#mode nostring "\!#''"'), file_nl(DBFilePort),
%% get data from stdin, dump to DBFilePort (redirected to DBFileName)
xpp_process_file(IntoXPP,XPP_process,DBFilePort),
stat_set_flag(CURRENT_OUTPUT,IntoXPP),
%% Include the Macro definitions.
writeln('#include "flrheader.flh"'),
nl,
flora_extern_code(FactList,CoderStatus),
( CoderStatus == [] ->
FileStatus=FLORA_SUCCESS
;
flora_coder_error(CoderStatus),
FileStatus=FLORA_FAILURE
),
file_close(IntoXPP),
process_control(XPP_process,wait(ExitStatus)),
(ExitStatus==0, !
; flora_error_line('Error while generating ~w', [DBFileName])
),
flora_clear_xpp_options,
file_write(DBFilePort,'#mode restore'), file_nl(DBFilePort),
file_close(DBFilePort),
tell(PreOutFile),
!.
*/
/*************************************************************************
flora_loaddyn_data(+InFile,+ModuleName,+Ext)
This procedure reads a Flora DB/FLD file that contains facts in canonical
form and inserts them into the storage trie for the module. The module
could be either a Flora user module, or a Flora system module. In the
latter case, it is structured term.
*************************************************************************/
flora_loaddyn_data(InFile,ModuleName,Ext) :-
flora_check_filename(InFile),
( flora_file_op(isabsolute,InFile) ->
InFileAbs=InFile
; current_loaded_file(LoadedFile) ->
flora_file_op(dirname,LoadedFile,FileDir),
flora_concat_atoms([FileDir,InFile],InFileAbs)
;
InFileAbs=InFile
),
!,
( flora_locate_file(InFileAbs,File) ->
flora_message_line('Dynamically loading ~w into module ~w',
[File,ModuleName]),
flora_cputime(T0),
seeing(PreInFile),
flora_set_xpp_options_for_read(ModuleName),
%% Don't issue irrelevant warnings
flora_add_xpp_options('-warninglevel 1 '),
xpp_process_file(File,XPP_process,IOportFromProc),
stat_set_flag(CURRENT_INPUT,IOportFromProc),
( Ext==FLORA_FDB_EXT,
flora_fdb_storage_name(ModuleName,StorageName)
; Ext==FLORA_FLD_EXT,
flora_fld_storage_name(ModuleName,StorageName)
),
flora_read_canonical_and_insert(StorageName),
%% Wait, not to leave zombies.
process_control(XPP_process,wait(ExitStatus)),
(ExitStatus==0, !
; flora_error_line('Error while preprocessing ~w', [File])
),
%% Release the file descriptor used to read from xpp.
file_close(IOportFromProc),
flora_clear_xpp_options,
see(PreInFile),
flora_cputime(T1),
T is T1-T0,
flora_message_line('Done! CPU time used: ~w seconds',[T])
;
flora_error_line('File ~w does not exist', [InFileAbs]),
fail
),
!.
/*************************************************************************
flora_read_canonical_and_insert(+StorageName)
Read the current input in canonical form and insert all facts
into the storage trie.
*************************************************************************/
flora_read_canonical_and_insert(StorageName) :-
repeat,
read_canonical(Term),
( Term == end_of_file, !
;
flora_db_insert_base(StorageName,Term),
fail
).
/*************************************************************************
flora_read_canonical_and_insert(+File,+StorageName)
Same as flora_read_canonical_and_insert/1, but reads a file
*************************************************************************/
flora_read_canonical_and_insert(File,StorageName) :-
flora_message_line('Dynamically loading ~w into storage ~w',
[File,StorageName]),
seeing(OldF),
see(File),
flora_read_canonical_and_insert(StorageName),
seen,
see(OldF).
/*************************************************************************
Commit all backtrackable updates to Flora storage
**************************************************************************/
flora_commit_storage :-
(flora_storage_registry(StorageName),
flora_db_commit(StorageName),
fail
; true).
/*************************************************************************
Collect garbage in Flora storage tries
Should be called only after it is certain that backtracking
over deleted facts cannot occur.
**************************************************************************/
flora_reclaim_storage_space :-
(flora_storage_registry(StorageName),
flora_db_reclaim_space(StorageName),
fail
; true).
/*************************************************************************
flora_rpc_file(+MaxErr,+ErrNum,+WarnNum,-CompiledRuleList,-FileOptionList,-FileStatus)
*************************************************************************/
%% The first argument keeps track of the tail of a list.
flora_tailappend(V,[],V) :- !.
flora_tailappend([H|V],[H|L],T) :- flora_tailappend(V,L,T).
%% Calls the compiler. This is used to wrap templates, like trailers,
%% with the WORKSPACE macros.
flora_rpc_file(MaxErr,ErrNum,WarnNum,CompiledRuleList,FileOptionList,FileStatus) :-
flora_read_parse_compile(FLORA_FILE,Tokens,
CompiledRuleList-NewCompiledRuleList,
RuleOptions,RuleStatus),
member(error(EN),RuleStatus),
member(warning(WN),RuleStatus),
NewErrNum is ErrNum+EN,
NewWarnNum is WarnNum+WN,
( EN > 0 -> %% errors just found
( MaxErr \== FLORA_ALL, NewErrNum >= MaxErr ->
FileStatus=FLORA_FAILURE,
flora_stderr_nl,
flora_errorwarn_count(NewErrNum,NewWarnNum),
flora_stderr_nl,
flora_stderr_string('++compilation aborted'),
flora_stderr_nl
; flora_rule_delimeter_struct(_,_,_,_,_,RuleDelimeterToken),
flora_not_end_of_input(RuleStatus), member(RuleDelimeterToken,Tokens) ->
flora_rpc_file(MaxErr,NewErrNum,NewWarnNum,
_CompiledRuleList,_FileOptionList,FileStatus)
; flora_not_end_of_input(RuleStatus), flora_discard_tokens ->
flora_rpc_file(MaxErr,NewErrNum,NewWarnNum,
_CompiledRuleList,_FileOptionList,FileStatus)
;
FileStatus=FLORA_FAILURE,
flora_stderr_nl,
flora_errorwarn_count(NewErrNum,NewWarnNum),
flora_stderr_nl,
flora_stderr_string('++compilation aborted'),
flora_stderr_nl
)
;
( NewErrNum == 0 -> %% no error so far
flora_tailappend(FileOptionList,RuleOptions,NewFileOptionList)
;
true
),
( flora_not_end_of_input(RuleStatus) ->
flora_rpc_file(MaxErr,NewErrNum,NewWarnNum,
NewCompiledRuleList,NewFileOptionList,FileStatus)
; %% end of file already
( NewErrNum == 0 ->
NewCompiledRuleList=[],
NewFileOptionList=[],
FileStatus=FLORA_SUCCESS,
( NewWarnNum == 0 ->
true
;
flora_stdwarn_nl,
flora_errorwarn_count(NewErrNum,NewWarnNum)
)
;
FileStatus=FLORA_FAILURE,
flora_stderr_nl,
flora_errorwarn_count(NewErrNum,NewWarnNum),
flora_stderr_nl,
flora_stderr_string('++compilation aborted'),
flora_stderr_nl
)
)
),
!.
/*************************************************************************
flora_discard_tokens/0
Scan the input until a rule delimeter is found. Fails if eof.
*************************************************************************/
flora_discard_tokens :-
flora_warning_line('Discarding tokens (rule delimeter `.'' or EOF expected)'),
repeat,
flora_tokens(Tokens,Status),
flora_rule_delimeter_struct(_Txt,_LN1,_CN1,_LN2,_CN2,RuleDelimeterToken),
( flora_end_of_input(Status) ->
!,
fail
; member(RuleDelimeterToken,Tokens) ->
!
;
fail
).
/*************************************************************************
flora_read_parse_compile(+Option,-Tokens,-FlattenedRules,-OptionList,-Status)
Note: This procedure can be used to read both file and command line.
For reading file, Option is FLORA_FILE. For reading command line,
Option is FLORA_COMMANDLINE.
FlattenedRules is a difference list in the form of List-Tail,
where Tail is the tail of List. Tail is unbound when this procedure
returns and so it should be set to [] later accordingly to close
the end of the list.
*************************************************************************/
flora_read_parse_compile(Option,Tokens,FlattenedRules,OptionList,Status) :-
flora_tokens(InputTokens,LexerStatus),
flora_lexer_error(InputTokens,LexerStatus,LexErrNum),
( LexErrNum > 0 ->
Tokens=InputTokens,
FlattenedRules=T-T,
OptionList=[],
ErrNum=LexErrNum,
WarnNum=0
; flora_blank_line(InputTokens) ->
Tokens=InputTokens,
FlattenedRules=T-T,
OptionList=[],
ErrNum=0,
WarnNum=0
;
( Option == FLORA_COMMANDLINE ->
flora_construct_query_term(InputTokens,Tokens)
;
Tokens=InputTokens
),
flora_compose(Tokens,ComposerTerm,ComposerStatus),
flora_composer_errorwarn(ComposerStatus,CompoErrNum,CompoWarnNum),
( CompoErrNum > 0 ->
FlattenedRules=T-T,
OptionList=[],
ErrNum=CompoErrNum,
WarnNum=CompoWarnNum
;
flora_parse(ComposerTerm,ParserTerm,ParserStatus),
flora_parser_error(ParserStatus,ParErrNum),
( ParErrNum > 0 ->
FlattenedRules=T-T,
OptionList=[],
ErrNum=ParErrNum,
WarnNum=CompoWarnNum
;
flora_compile(ParserTerm,FlattenedRules,OptionList,CompilerStatus),
flora_compiler_errorwarn(CompilerStatus,CompiErrNum,CompiWarnNum),
ErrNum=CompiErrNum,
WarnNum is CompoWarnNum+CompiWarnNum
)
)
),
EWS=[error(ErrNum),warning(WarnNum)],
( flora_end_of_input(LexerStatus) ->
Status=[FLORA_EOF|EWS]
;
Status=[FLORA_NOT_EOF|EWS]
).
/*************************************************************************
flora_construct_query_term(+InputTokens,-Tokens)
Construct a query term from the shell command line input. Two extra
pair of parentheses are added to enclose the input. This is to prevent
the query term from being intepreted as having arity other than one.
*************************************************************************/
flora_construct_query_term(InputTokens,Tokens) :-
flora_symbol_token_struct("?-",1,0,1,0,QueryOpToken),
flora_symbol_token_struct("(",1,0,1,0,LPToken),
Tokens=[QueryOpToken,LPToken,LPToken|L],
flora_construct_rest_query_term(InputTokens,L).
flora_construct_rest_query_term([T],[RPToken,RPToken,T]) :-
!,
%% This last one from the input tokens is the rule delimeter.
flora_symbol_token_struct(")",1,0,1,0,RPToken).
flora_construct_rest_query_term([T|Ts],[T|L]) :-
flora_construct_rest_query_term(Ts,L).
/*************************************************************************
flora_good_command(+Status)
flora_bad_command(+Status)
flora_noop_command(+Status)
*************************************************************************/
flora_good_command(Status) :- member(FLORA_SUCCESS,Status).
flora_bad_command(Status) :- member(FLORA_FAILURE,Status).
flora_noop_command(Status) :- member(FLORA_NOOP,Status).
/*************************************************************************
flora_shell_command_line(-Code,-Options,-Status)
*************************************************************************/
flora_shell_command_line(Code,Options,Status) :-
flora_reset_modules_for_shell,
flora_read_parse_compile(FLORA_COMMANDLINE,Tokens,Rules-[],
RuleOptions,RuleStatus),
member(error(ErrNum),RuleStatus),
( ErrNum > 0 ->
( flora_end_of_input(RuleStatus) ->
InputStatus=FLORA_EOF
; flora_rule_delimeter_struct(_,_,_,_,_,RuleDelimeterToken),
member(RuleDelimeterToken,Tokens) ->
InputStatus=FLORA_NOT_EOF
; flora_discard_tokens ->
InputStatus=FLORA_NOT_EOF
;
InputStatus=FLORA_EOF
),
Status=[InputStatus,FLORA_FAILURE]
;
( Rules == [] ->
CommandStatus=FLORA_NOOP
;
flora_intern_code(Rules,FLORA_DEFAULT_WORKSPACE,Code,CoderStatus),
( CoderStatus == [] ->
CommandStatus=FLORA_SUCCESS
;
flora_coder_error(CoderStatus),
CommandStatus=FLORA_FAILURE
)
),
sort(RuleOptions,Options),
( flora_end_of_input(RuleStatus) ->
Status=[FLORA_EOF,CommandStatus]
;
Status=[FLORA_NOT_EOF,CommandStatus]
)
),
!.
/*************************************************************************
flora_flrfilename_error(+FileName)
This procedure is called when search for a Flora file is failed. The
failure may be due to incorrect file name extension or non-existence.
*************************************************************************/
flora_flrfilename_error(File) :-
( parse_filename(File,_,_,Ext), Ext \== '', Ext \== FLORA_FILE_EXT,
flora_file_op(exists,File) ->
flora_stderr_nl,
flora_error_line('~w: Filename extension must be ~w',
[File,FLORA_FILE_EXT])
;
flora_stderr_nl,
flora_error_line('File ~w[.~w] does not exist',[File,FLORA_FILE_EXT])
),
!.
/*************************************************************************
utilities
*************************************************************************/
flora_errorwarn_count(ErrNum,WarnNum) :-
( ErrNum == 1 ->
flora_stderr_string('++1 error'),
flora_stderr_nl, flora_stderr_nl
; ErrNum > 1 ->
flora_stderr_string('++~w errors',[ErrNum]),
flora_stderr_nl, flora_stderr_nl
;
true
),
( WarnNum == 1 ->
flora_stdwarn_string('++1 warning'),
flora_stderr_nl, flora_stderr_nl
; WarnNum > 1 ->
flora_stdwarn_string('++~w warnings',[WarnNum]),
flora_stderr_nl, flora_stderr_nl
;
true
),
!.
flora_last_element([T],T) :- !.
flora_last_element([_|L],T) :- flora_last_element(L,T).
/*************************************************************************
flora_lexer_error(+Tokens,+LexerStatus,-ErrNum)
*************************************************************************/
flora_lexer_error(Tokens,LexerStatus,ErrNum) :-
( member(error(Msg),LexerStatus) ->
flora_last_element(Tokens,Tk),
flora_token_text(Tk,TextStr,_BLN,_BCN,ELN,ECN),
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Lexer] near line(~w)/char(~w) `~s''',
[FileName,ELN,ECN,TextStr])
;
flora_error_line('[Lexer] near line(~w)/char(~w) `~s''',
[ELN,ECN,TextStr])
),
flora_error_indentline,
flora_stderr_string('~w',[Msg]),
flora_stderr_nl,
ErrNum=1
;
ErrNum=0
).
/*************************************************************************
flora_composer_errorwarn(+ComposerStatus,-ErrNum,-WarnNum)
*************************************************************************/
flora_composer_errorwarn([],0,0) :- !.
flora_composer_errorwarn([error(Indx,Msg)|L],ErrNum,WarnNum) :-
!,
flora_nth_token(Indx,Tk),
flora_token_text(Tk,TextStr,BLN,BCN,_ELN,_ECN),
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Composer] near line(~w)/char(~w) `~s''',
[FileName,BLN,BCN,TextStr])
;
flora_error_line('[Composer] near line(~w)/char(~w) `~s''',
[BLN,BCN,TextStr])
),
flora_error_indentline,
flora_stderr_string('~w',[Msg]),
flora_stderr_nl,
flora_composer_errorwarn(L,EN,WarnNum),
ErrNum is EN+1.
flora_composer_errorwarn([error(I1,I2,Msg)|L],ErrNum,WarnNum) :-
!,
flora_nth_token(I1,Tk1),
flora_nth_token(I2,Tk2),
flora_token_text(Tk1,TextStr1,BLN1,BCN1,_ELN1,_ECN1),
flora_token_text(Tk2,TextStr2,BLN2,BCN2,_ELN2,_ECN2),
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Composer] near line(~w)/char(~w) `~s'' and near line(~w)/char(~w) `~s''',
[FileName,BLN1,BCN1,TextStr1,BLN2,BCN2,TextStr2])
;
flora_error_line('[Composer] near line(~w)/char(~w) `~s'' and near line(~w)/char(~w) `~s''',
[BLN1,BCN1,TextStr1,BLN2,BCN2,TextStr2])
),
flora_error_indentline,
flora_stderr_string('~w',[Msg]),
flora_stderr_nl,
flora_composer_errorwarn(L,EN,WarnNum),
ErrNum is EN+1.
flora_composer_errorwarn([warning(I1,I2,Msg)|L],ErrNum,WarnNum) :-
!,
flora_nth_token(I1,Tk1),
flora_nth_token(I2,Tk2),
flora_token_text(Tk1,TextStr1,BLN1,BCN1,_ELN1,_ECN1),
flora_token_text(Tk2,TextStr2,BLN2,BCN2,_ELN2,_ECN2),
( flora_current_compile_filename(FileName) ->
flora_warning_line('[~w] [Composer] near line(~w)/char(~w) `~s'' and near line(~w)/char(~w) `~s''',
[FileName,BLN1,BCN1,TextStr1,BLN2,BCN2,TextStr2])
;
flora_warning_line('[Composer] near line(~w)/char(~w) `~s'' and near line(~w)/char(~w) `~s''',
[BLN1,BCN1,TextStr1,BLN2,BCN2,TextStr2])
),
flora_warning_indentline,
flora_stdwarn_string("~w~n",[Msg]),
flora_composer_errorwarn(L,ErrNum,WN),
WarnNum is WN+1.
flora_composer_errorwarn([error(Msg)|L],ErrNum,WarnNum) :-
!,
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Composer] ~w',[FileName,Msg])
;
flora_error_line('[Composer] ~w',[Msg])
),
flora_composer_errorwarn(L,EN,WarnNum),
ErrNum is EN+1.
/*************************************************************************
flora_parser_error(+ParserStatus,-ErrNum)
*************************************************************************/
flora_parser_error([],0) :- !.
flora_parser_error([error(Indx,Msg)|L],ErrNum) :-
!,
flora_nth_token(Indx,Tk),
flora_token_text(Tk,TextStr,BLN,BCN,_ELN,_ECN),
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Parser] near line(~w)/char(~w) `~s''',
[FileName,BLN,BCN,TextStr])
;
flora_error_line('[Parser] near line(~w)/char(~w) `~s''',
[BLN,BCN,TextStr])
),
flora_error_indentline,
flora_stderr_string('~w',[Msg]),
flora_stderr_nl,
flora_parser_error(L,EN),
ErrNum is EN+1.
flora_parser_error([error(Msg)|L],ErrNum) :-
!,
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Parser] ~w',[FileName,Msg])
;
flora_error_line('[Parser] ~w',[Msg])
),
flora_parser_error(L,EN),
ErrNum is EN+1.
check_for_dependencies_errorwarn([],0,0) :- !.
check_for_dependencies_errorwarn([warning(Msg)|L],WarnNum,ErrNum) :-
!,
( flora_current_compile_filename(FileName) ->
flora_warning_line('[~w] [Dependency check] ~w', [FileName,Msg])
;
flora_warning_line('[Dependency check] ~w', [Msg])
),
check_for_dependencies_errorwarn(L,WN,ErrNum),
WarnNum is WN+1.
check_for_dependencies_errorwarn([error(Msg)|L],WarnNum,ErrNum) :-
!,
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Dependency check] ~w', [FileName,Msg])
;
flora_error_line('[Dependency check] ~w', [Msg])
),
check_for_dependencies_errorwarn(L,WarnNum,EN),
ErrNum is EN+1.
/*************************************************************************
flora_compiler_errorwarn(+CompilerStatus,-ErrNum,-WarnNum)
*************************************************************************/
flora_compiler_errorwarn([],0,0) :- !.
flora_compiler_errorwarn([error(Indx,Msg)|L],ErrNum,WarnNum) :-
!,
flora_nth_token(Indx,Tk),
flora_token_text(Tk,TextStr,BLN,BCN,_ELN,_ECN),
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Compiler] near line(~w)/char(~w) `~s''',
[FileName,BLN,BCN,TextStr])
;
flora_error_line('[Compiler] near line(~w)/char(~w) `~s''',
[BLN,BCN,TextStr])
),
flora_error_indentline,
flora_stderr_string('~w~n',[Msg]),
flora_compiler_errorwarn(L,EN,WarnNum),
ErrNum is EN+1.
flora_compiler_errorwarn([warning(Indx,Msg)|L],ErrNum,WarnNum) :-
!,
flora_nth_token(Indx,Tk),
flora_token_text(Tk,TextStr,BLN,BCN,_ELN,_ECN),
( flora_current_compile_filename(FileName) ->
flora_warning_line('[~w] [Compiler] near line(~w)/char(~w) `~s''',
[FileName,BLN,BCN,TextStr])
;
flora_warning_line('[Compiler] near line(~w)/char(~w) `~s''',
[BLN,BCN,TextStr])
),
flora_warning_indentline,
flora_stdwarn_string("~w~n",[Msg]),
flora_compiler_errorwarn(L,ErrNum,WN),
WarnNum is WN+1.
flora_compiler_errorwarn([error(Msg)|L],ErrNum,WarnNum) :-
!,
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Compiler] ~w',[FileName,Msg])
;
flora_error_line('[Compiler] ~w',[Msg])
),
flora_compiler_errorwarn(L,EN,WarnNum),
ErrNum is EN+1.
/*************************************************************************
flora_coder_error(+CoderStatus)
*************************************************************************/
flora_coder_error([]) :- !.
flora_coder_error([error(Msg)|L]) :-
!,
( flora_current_compile_filename(FileName) ->
flora_error_line('[~w] [Coder] ~w',[FileName,Msg])
;
flora_error_line('[Coder] ~w',[Msg])
),
flora_coder_error(L).
/*****************************************************************************
flora_list2conjunct(+List,-Goal)
*****************************************************************************/
flora_list2conjunct([G],G) :- !.
flora_list2conjunct([G|L],Goal) :-
!,
flora_list2conjunct(L,LG),
Goal =.. [',',G,LG].
/*************************************************************************
flMaxerr(+Num)
*************************************************************************/
:- flMaxerr(8).
flMaxerr(X) :-
( var(X) ->
flora_maxerr(X)
; X \== FLORA_ALL, (not integer(X); X < 1) ->
flora_error_line('Invalid argument to maxerr'),
fail
;
retractall(flora_maxerr(_)),
assert(flora_maxerr(X))
).
/*************************************************************************
flHalt/0
*************************************************************************/
flHalt :- halt.
/*************************************************************************
flDump/1
*************************************************************************/
flDump(InFile>>Workspace) :-
flora_dump_file(InFile,Workspace,dontsquash).
flDump(InFile) :-
flora_dump_file(InFile,FLORA_DEFAULT_WORKSPACE,squash).
/*************************************************************************
flora_dump_file(+File,+Workspace,+SquashingOption)
Expects a Flora file as input and dumps the .P file in a more readable
format. If SquashingOption == squash, ignore Workspace in the final round
of gpp pre-processing.
*************************************************************************/
flora_dump_file(InFile,Workspace,SquashingOption) :-
flora_check_filename(InFile),
flora_check_workspace(Workspace),
( flora_locate_file(InFile,FLORA_FILE_EXT,FlrFile), !
; flora_flrfilename_error(InFile),
!,
fail
),
%% Find the files that need to be dumped.
flora_mainP_filename(FlrFile,PFile),
flora_FDB_filename(FlrFile,FDBFile),
flora_FLD_filename(FlrFile,FLDFile),
flora_dump_filename(PFile,DumpPFile),
flora_dump_filename(FDBFile,DumpFDBFile),
flora_dump_filename(FLDFile,DumpFLDFile),
flora_set_xpp_options_for_compile,
flora_compile_file(FlrFile,PFile,FDBFile,FLDFile,Status),
( Status == FLORA_FAILURE -> flora_clear_xpp_options, !, fail
; true
),
flora_clear_xpp_options,
!,
%% Compilation has succeeded. Need to dump file contents.
( SquashingOption == squash -> NewWorkspace=''
;
%% Add '_' to the workspace to simplify reading.
str_cat(Workspace,'_',NewWorkspace)
),
!,
( flora_file_op(exists,PFile) ->
%% Dump the main .P file.
flora_gpp_dumpfile(PFile,DumpPFile,NewWorkspace)
;
flora_error_line('Failed to create the main dumpfile ~w',
[PFile])
),
( flora_file_op(exists,FDBFile) ->
%% Dump the .fdb file if it exists.
flora_gpp_dumpfile(FDBFile,DumpFDBFile,NewWorkspace)
;
true
),
( flora_file_op(exists,FLDFile) ->
%% Dump the .fld file if it exists.
flora_gpp_dumpfile(FLDFile,DumpFLDFile,NewWorkspace)
;
true
),
!.
/*************************************************************************
flora_gpp_dumpfile(+FileName,+DumpFileName,+Workspace)
When this procedure is called, the input file is already checked
for existence.
*************************************************************************/
flora_gpp_dumpfile(FileName,DumpFileName,Workspace) :-
flora_message_line('Making dump file ~w from ~w',
[DumpFileName,FileName]),
parse_filename(DumpFileName,_,Base,_),
flora_concat_atoms(['-D FLORA_DUMP -D FLORA_FDB_FILENAME="''',
Base,'.',FLORA_FDB_EXT,
'''" -D FLORA_FLD_FILENAME="''',
Base,'.',FLORA_FLD_EXT,'''"'],
ExtraOptions),
flora_set_xpp_options_for_dump(Workspace,ExtraOptions),
xpp_process_file(FileName,XPP_process,IOportFromGPP),
%% Save standard input and output ports
stat_flag(CURRENT_INPUT, StdIn),
stat_flag(CURRENT_OUTPUT, StdOut),
%% Pipe gpp output to standard input
stat_set_flag(CURRENT_INPUT,IOportFromGPP),
%% Pipe standard output to the dump file
file_open(DumpFileName,w,DumpPort),
stat_set_flag(CURRENT_OUTPUT,DumpPort),
%% do prettyprinting; gpp output is now piped through
%% this predicate to the dumpfile
prettyprint_stdin,
process_control(XPP_process,wait(ExitStatus)),
(ExitStatus==0, !
; flora_error_line('Error while preprocessing ~w', FileName)
),
flora_clear_xpp_options,
file_close(IOportFromGPP),
file_close(DumpPort),
%% Restore the old stdin and stdout
stat_set_flag(CURRENT_INPUT,StdIn),
stat_set_flag(CURRENT_OUTPUT,StdOut),
!.
flora_gpp_dumpfile(FileName,_DumpFileName,_Workspace) :-
flora_error_line('Failed to make a dump file for ~w',[FileName]),
!,
fail.
/*****************************************************************************
flora_measure_time(+Call,+Message)
Tells now much time the call has been executing.
Message is printed to identify the call.
*****************************************************************************/
flora_measure_time(Call,Message) :-
flora_cputime(T1),
call(Call),
flora_cputime(T2),
Delta is T2 - T1,
flora_message_line('~w ~w seconds',[Message,Delta]).
%% From, To are file names. Variable means stdin or stdout, respectively
flora_copy_input(From,To) :-
(var(From), ! ; seeing(OldIn), see(From)),
(var(To), ! ; telling(OldOut), tell(To)),
flora_copy_input,
(var(From), ! ; seen, see(OldIn)),
(var(To), ! ; told, tell(OldOut)).
flora_abort :- close_open_tables, throw(FLORA_ABORT).
flora_abort(Msg) :-
is_list(Msg), !,
flora_concat_items(Msg,AtomMsg),
close_open_tables, throw(FLORA_ABORT(AtomMsg)).
flora_abort(Msg) :- close_open_tables, throw(FLORA_ABORT(Msg)).
syntax highlighted by Code2HTML, v. 0.9.1