% -----------------------------------------------------------------------------
%  (C) Altran Praxis Limited
% -----------------------------------------------------------------------------
% 
%  The SPARK toolset is free software; you can redistribute it and/or modify it
%  under terms of the GNU General Public License as published by the Free
%  Software Foundation; either version 3, or (at your option) any later
%  version. The SPARK toolset is distributed in the hope that it will be
%  useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
%  Public License for more details. You should have received a copy of the GNU
%  General Public License distributed with the SPARK toolset; see file
%  COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
%  the license.
% 
% =============================================================================


%###############################################################################
% PURPOSE
%-------------------------------------------------------------------------------
% Establish the declarations for this session. Most of the declarations are
% retrieved from a provided declaration file.
%###############################################################################


%###############################################################################
% MODULE
%###############################################################################

:- module(load__declarations,
          [load_declarations/0,
           save_used_identifier/2]).


%###############################################################################
% DEPENDENCIES
%###############################################################################

:- use_module('data__formats.pro',
              [add_type/2]).

:- use_module('data__declarations.pro',
              [add_declarations_constant/2,
               add_declarations_function/3,
               add_declarations_record_function/6,
               add_declarations_type/2,
               add_declarations_unbounded_function/3,
               add_declarations_used_identifier/1,
               add_declarations_variable/2,
               get_declarations_type/2,
               get_declarations_used_identifier/1,
               type_alias/2,
               pre_calculate_legacy_fdl/0]).

:- use_module('ioutilities.pro',
              [read_lines_from_file_as_char_list/3,
               read_line_from_stream/2,
               throw_error/2]).

:- use_module('newutilities.pro',
              [flatten_list/2,
               implode_separator_content_list/3,
               trim_atom/3]).

:- use_module('simplifier_ioutilities.pro',
              [retrieve_declaration_file/1,
               convert_file_for_display/2]).

:- use_module('parseutilities.pro',
              [atom_to_lower_case/2,
               parse_all_to_nothing/2,
               parse_atom/5,
               parse_atom_silent/4,
               parse_char_sep_atom_list/6,
               parse_nothing_to_all/2,
               parse_number/3,
               parse_possibly_signed_atom/4]).

:- use_module('data__provenance.pro',
              [get_provenance_framework/1]).


:- set_prolog_flag(double_quotes, chars).


%###############################################################################
% TYPES
%###############################################################################

:- add_type('FDL',
            [comment,
             title('Title'),
             packed_variable('TypeId_Atom', 'VarId_AtomList'),
             variable('TypeId_Atom', 'VarId_Atom'),
             constant('TypeId_Atom', 'ConstId_Atom'),
             type('TypeId_Atom', 'TypeStructure'),
             function('TypeId_Atom', 'Function_Atom', 'ArgTypeId_AtomList'),
             end]).

:- add_type('Title',
            [procedure('Atom'),
             function('Atom'),
             anonymous('Atom')]).

:- add_type('TypeStructure',
            [pending,
             range('Lower_Int', 'Upper_Int'),
             array('IndexTypeId_AtomList', 'ElementTypeId_Atom'),
             enumeration('EnumId_AtomList'),
             record('FieldList'),
             sequence('ElementTypeId_Atom'),
             set('ElementTypeId_Atom'),
             alias('AliasTypeId_Atom')]).

:- add_type('Field',
            [packed_field('TypeId_Atom', 'FieldId_AtomList'),
             field('TypeId_Atom', 'FieldId_Atom')]).


%###############################################################################
% DATA
%###############################################################################


%###############################################################################
% PREDICATES
%###############################################################################

:- dynamic(current_record_field_number/1).

%===============================================================================
% load_declarations.
%-------------------------------------------------------------------------------
% Loads all declarations from the known declaration file.
%===============================================================================

load_declarations :-
    nl,
    retrieve_declaration_file(DeclarationFile_Atom),
    convert_file_for_display(DeclarationFile_Atom, DisplayDeclarationFile_Atom),
    write('Reading '),
    write(DisplayDeclarationFile_Atom),
    write(' (for inherited FDL type declarations)'),
    nl,







    assertz(current_record_field_number(1)),

    load_declarations_static,
    load_declarations_file,


    pre_calculate_legacy_fdl,
    !.

%-------------------------------------------------------------------------------

load_declarations_file:-
    retrieve_declaration_file(File_Atom),
    read_lines_from_file_as_char_list(File_Atom, everyLine, CharList),
    load_declarations_from_char_list(CharList),
    !.

%-------------------------------------------------------------------------------





load_declarations_static:-
    implode_separator_content_list('\n',
                                   ['function bit__and(integer, integer) : integer;',
                                    'function bit__or(integer, integer) : integer;',
                                    'function bit__xor(integer, integer) : integer;'],
                                   Content_Atom),
    atom_chars(Content_Atom, Content_CharList),
    load_declarations_from_char_list(Content_CharList),
    !.

%===============================================================================
% load_declarations_from_char_list(+CharList).
%-------------------------------------------------------------------------------
% Load all declarations from the large character list (CharList).
%===============================================================================

load_declarations_from_char_list(CharList):-
    % Retrieve all declarations.
    retrieve_declarations_items(CharList, FDLList),

    % Flatten all declarations.
    unpack_declarations_items(FDLList, Unpacked_FDLList),

    % Standardise all declarations.
    standardise_declarations_items(Unpacked_FDLList, Standardised_FDLList),

    % Process all declarations.
    process_declarations_items(Standardised_FDLList),
    !.

%===============================================================================
% retrieve_declarations_items(+CharList, -FDLList).
%-------------------------------------------------------------------------------
% Retrieve all declarations items as (FDLList) from the provided character
% list (CharList). The declarations items are encoded to closely reflect
% their original presentation form.
%===============================================================================

% Make the parse_declarations call visible to the spxref tool.
:- public parse_declarations/3.

retrieve_declarations_items(CharList, FDLList):-
    phrase(parse_declarations(FDLList), CharList),
    !.

retrieve_declarations_items(_CharList, _FDLList):-
    throw_error('Error in parsing declarations.\n', []).

%-------------------------------------------------------------------------------

parse_declarations([FDL | FDLList]) -->
    parse_atom_silent([space, newline], zeroormore),
    parse_declarations_item(FDL),
    parse_declarations(FDLList).

parse_declarations([]) -->
    !.

%-------------------------------------------------------------------------------

% Comment.
% { ... }
parse_declarations_item(comment) -->
    "{",
    parse_atom_silent([space, newline], zeroormore),
    parse_declarations_comment_contents,
    parse_atom_silent([space, newline], zeroormore),
    "}",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Title.
% title procedure addsuccessfulentry;
parse_declarations_item(title(procedure(Subprogram_Atom))) -->
    "title",
    parse_atom_silent([space, newline], oneormore),
    "procedure",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, Subprogram_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

parse_declarations_item(title(function(Subprogram_Atom))) -->
    "title",
    parse_atom_silent([space, newline], oneormore),
    "function",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, Subprogram_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

parse_declarations_item(title(anonymous(Description_Atom))) -->
    "title",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([not(semicolon)], oneormore, Description_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Variable.
% var a : integer;
parse_declarations_item(packed_variable(TypeId_Atom, VarId_AtomList)) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "var",
    parse_atom_silent([space, newline], oneormore),
    parse_char_sep_atom_list([alpha_numeric, under_score],
                             [space, newline], ',', VarId_AtomList),
    parse_atom_silent([space, newline], zeroormore),
    ":",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.





% Constant.
% const basictypes__unsigned32t__size : integer = pending;
parse_declarations_item(constant(ConstId_Atom, TypeId_Atom)) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "const",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, ConstId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ":",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom_silent([not(semicolon)], oneormore),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type pending.
parse_declarations_item(type(TypeId_Atom, pending)) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    "pending",
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.





% Type range.
parse_declarations_item(type(TypeId_Atom, range(Lower_Term, Upper_Term))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    parse_possibly_signed_atom([alpha_numeric, under_score], Lower_Term),
    parse_atom_silent([space, newline], zeroormore),
    "..",
    parse_atom_silent([space, newline], zeroormore),
    parse_possibly_signed_atom([alpha_numeric, under_score], Upper_Term),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type array.
% type issystemt = array [keystore__interface__returnvaluet] of boolean;
parse_declarations_item(type(TypeId_Atom, array(IndexTypeId_AtomList, ElementTypeId_Atom))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    "array",
    parse_atom_silent([space, newline], zeroormore),
    "[",
    parse_atom_silent([space, newline], zeroormore),
    parse_char_sep_atom_list([alpha_numeric, under_score],
                             [space, newline], ',', IndexTypeId_AtomList),
    parse_atom_silent([space, newline], zeroormore),
    "]",
    parse_atom_silent([space, newline], zeroormore),
    "of",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, ElementTypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type enumeration.
% type p__colour = (p__red, p__green, p__blue, p__purple);
parse_declarations_item(type(TypeId_Atom, enumeration(EnumId_AtomList))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    "(",
    parse_atom_silent([space, newline], zeroormore),
    parse_char_sep_atom_list([alpha_numeric, under_score],
                             [space, newline], ',', EnumId_AtomList),
    parse_atom_silent([space, newline], zeroormore),
    ")",
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type record.
% type cert__id__contentst = record
%  inherit : cert__contentst
% end;
% type p__r = record
%  f1 : integer;
%  f2 : p__colour
% end;
parse_declarations_item(type(TypeId_Atom, record(FieldList))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    "record",
    parse_atom_silent([space, newline], oneormore),
    parse_record_fields(FieldList),
    parse_atom_silent([space, newline], zeroormore),
    "end;",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type sequence.
parse_declarations_item(type(TypeId_Atom, sequence(ElementTypeId_Atom))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    "sequence",
    parse_atom_silent([space, newline], oneormore),
    "of",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, ElementTypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type set.
parse_declarations_item(type(TypeId_Atom, set(ElementTypeId_Atom))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    "set",
    parse_atom_silent([space, newline], oneormore),
    "of",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, ElementTypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Type alias. (type declared to be as other type).
% type ada__real_time__time_span = integer;
parse_declarations_item(type(TypeId_Atom, alias(AliasTypeId_Atom))) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "type",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "=",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, AliasTypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.


% Function. (with arguments)
% function round__(real) : integer;
parse_declarations_item(function(TypeId_Atom, Function_Atom, ArgTypeId_AtomList)) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "function",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, Function_Atom),
    parse_atom_silent([space, newline], zeroormore),
    "(",
    parse_atom_silent([space, newline], zeroormore),
    parse_char_sep_atom_list([alpha_numeric, under_score],
                             [space, newline], ',', ArgTypeId_AtomList),
    parse_atom_silent([space, newline], zeroormore),
    ")",
    parse_atom_silent([space, newline], zeroormore),
    ":",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% Function. (without arguments)
parse_declarations_item(function(TypeId_Atom, Function_Atom, [])) -->
    parse_optional_proof,
    parse_atom_silent([space, newline], zeroormore),
    "function",
    parse_atom_silent([space, newline], oneormore),
    parse_atom([alpha_numeric, under_score], oneormore, Function_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ":",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

% End.
parse_declarations_item(end) -->
    "end",
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.




% 'finish' is accepted, with any arguments following.
parse_declarations_item(end) -->
    parse_other_terminal,
    parse_nothing_to_all,
    ";",
    parse_atom_silent([space, newline], zeroormore),

    %Stop parsing the file now.
    parse_all_to_nothing,
    !.

% 'start' is accepted as the token at the end of a line just like ';'.
parse_declarations_item(end) -->
    parse_other_terminal,
    parse_nothing_to_all,
    "start",
    parse_atom_silent([space, newline], zeroormore),
    parse_all_to_nothing,
    !.

% End of file is accepted as the token at the end of a line.
parse_declarations_item(end) -->
    parse_other_terminal,
    parse_all_to_nothing,
    parse_atom_silent([space, newline], zeroormore),
    parse_all_to_nothing,
    !.







parse_declarations_item(ignored) -->
    parse_atom_silent([space, newline], zeroormore),
    parse_atom_silent([not(semicolon)], oneormore),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !.

%-------------------------------------------------------------------------------

parse_other_terminal -->
    "start".

parse_other_terminal -->
    "finish".

parse_other_terminal -->
    "end".

parse_other_terminal -->
    "enddeclarations".

%-------------------------------------------------------------------------------

parse_optional_proof -->
    "proof",
    parse_atom_silent([space, newline], oneormore),
    !.

parse_optional_proof -->
    !.

%-------------------------------------------------------------------------------

parse_declarations_comment_contents -->
    [Char],
    {\+ Char='}'},
    parse_declarations_comment_contents.

parse_declarations_comment_contents -->
    !.

%-------------------------------------------------------------------------------

% Continuation.
parse_record_fields([packed_field(TypeId_Atom, FieldId_AtomList) | T_FieldList]) -->
    parse_char_sep_atom_list([alpha_numeric, under_score],
                             [space, newline], ',', FieldId_AtomList),
    parse_atom_silent([space, newline], zeroormore),
    ":",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    ";",
    parse_atom_silent([space, newline], zeroormore),
    !,
    parse_record_fields(T_FieldList),
    !.

% Final.
parse_record_fields([packed_field(TypeId_Atom, FieldId_AtomList)]) -->
    parse_char_sep_atom_list([alpha_numeric, under_score],
                             [space, newline], ',', FieldId_AtomList),
    parse_atom_silent([space, newline], zeroormore),
    ":",
    parse_atom_silent([space, newline], zeroormore),
    parse_atom([alpha_numeric, under_score], oneormore, TypeId_Atom),
    parse_atom_silent([space, newline], zeroormore),
    !.

%===============================================================================
% unpack_declarations_items(+Packed_FDLList, -Unpacked_FDLList).
%-------------------------------------------------------------------------------
% The declarations items are transformed from closely reflecting their original
% potentially packed presentation form (Packed_FDLList) into a more
% flattened unpacked form (Unpacked_FDLList).
%===============================================================================

unpack_declarations_items(Packed_FDLList, Unpacked_FDLList):-
    unpack_declarations_items_x(Packed_FDLList, Unpacked_FDLListList),
    flatten_list(Unpacked_FDLListList, Unpacked_FDLList),
    !.

%-------------------------------------------------------------------------------

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

unpack_declarations_items_x([packed_variable(TypeId_Atom, VarId_AtomList) | T_Packed_FDLList],
                   [H_Unpacked_FDLList | T_Unpacked_FDLListList]):-
    unpack_variables(TypeId_Atom, VarId_AtomList, H_Unpacked_FDLList),
    unpack_declarations_items_x(T_Packed_FDLList,
                       T_Unpacked_FDLListList).

unpack_declarations_items_x([type(TypeId_Atom, record(FieldList)) | T_Packed_FDLList],
                   [type(TypeId_Atom, record(Unpacked_FieldList)) | T_Unpacked_FDLListList]):-
    unpack_record_fields(FieldList, Unpacked_FieldList),
    unpack_declarations_items_x(T_Packed_FDLList,
                       T_Unpacked_FDLListList).

% Just copy over all other forms.
unpack_declarations_items_x([H_Packed__Unpacked__FDL | T_Packed_FDLList],
                   [H_Packed__Unpacked__FDL | T_Unpacked_FDLListList]):-
    unpack_declarations_items_x(T_Packed_FDLList,
                       T_Unpacked_FDLListList).

%-------------------------------------------------------------------------------

unpack_variables(_TypeId_Atom,
                 [],
                 []):-
    !.

unpack_variables(TypeId_Atom,
                 [H_VarId_Atom | T_VarId_AtomList],
                 [variable(TypeId_Atom, H_VarId_Atom) | T_Unpacked_FDLList]):-
    unpack_variables(TypeId_Atom,
                     T_VarId_AtomList,
                     T_Unpacked_FDLList).

%-------------------------------------------------------------------------------

unpack_record_fields(Packed_FieldList,
                     Unpacked_FieldList):-
    unpack_record_fields_x(Packed_FieldList, Unpacked_FieldListList),
    flatten_list(Unpacked_FieldListList, Unpacked_FieldList),
    !.

%-------------------------------------------------------------------------------

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

unpack_record_fields_x([packed_field(TypeId_Atom, FieldId_AtomList) |
                        T_Packed_FieldList],
                       [H_Unpacked_FieldList | T_Unpacked_FieldListList]):-
    unpack_record_fields_xx(TypeId_Atom, FieldId_AtomList, H_Unpacked_FieldList),
    unpack_record_fields_x(T_Packed_FieldList,
                           T_Unpacked_FieldListList).

%-------------------------------------------------------------------------------

unpack_record_fields_xx(_TypeId_Atom, [], []):-
    !.

unpack_record_fields_xx(TypeId_Atom,
                        [H_FieldId_Atom | T_FieldId_AtomList],
                        [field(TypeId_Atom, H_FieldId_Atom)| T_Unpacked_FieldList]):-
    unpack_record_fields_xx(TypeId_Atom,
                            T_FieldId_AtomList,
                            T_Unpacked_FieldList).

%===============================================================================
% standardise_declarations_items(+FDLList, -Standardised_FDLList).
%-------------------------------------------------------------------------------
% The provided declarations items (FDLList) are transformed into a standard
% form.
%===============================================================================



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

standardise_declarations_items([H_FDL | T_FDLList],
                      [H_Standardised_FDL | T_Standardised_FDLList]):-
    standardise_declarations_item(H_FDL, H_Standardised_FDL),
    standardise_declarations_items(T_FDLList,
                          T_Standardised_FDLList).

%-------------------------------------------------------------------------------

standardise_declarations_item(Atom, Standard_Atom):-
    atomic(Atom),
    standardise_atom(Atom, Standard_Atom),
    !.

standardise_declarations_item(FunctorN, StandardFunctorN):-
    FunctorN =.. [Functor_Atom | Args_FunctorNList],
    standardise_atom(Functor_Atom, StandardFunctor_Atom),
    standardise_declarations_item_x(Args_FunctorNList,
                           StandardArgs_FunctorNList),
    StandardFunctorN =.. [StandardFunctor_Atom | StandardArgs_FunctorNList],
    !.

%-------------------------------------------------------------------------------

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

standardise_declarations_item_x([H_Args_FunctorN | T_Args_FunctorNList],
                       [H_StandardArgs_FunctorN | T_StandardArgs_FunctorNList]):-
    standardise_declarations_item(H_Args_FunctorN , H_StandardArgs_FunctorN),
    standardise_declarations_item_x(T_Args_FunctorNList,
                           T_StandardArgs_FunctorNList).

%-------------------------------------------------------------------------------

standardise_atom(Atom, Atom):-
    integer(Atom),
    !.

standardise_atom(Standard_Atom, Standard_Atom):-
    get_provenance_framework(spark),
    !.

standardise_atom(Atom, Standard_Atom):-
    get_provenance_framework(pascal),
    atom_to_lower_case(Atom, LowerCase_Atom),
    trim_atom(LowerCase_Atom, 24, Standard_Atom),
    !.

%===============================================================================
% process_declarations_items(+FDLList).
%-------------------------------------------------------------------------------
% The provided declarations items (FDLList) are processed, storing entries
% into the database.
%===============================================================================






process_declarations_items([]):-
    !.

process_declarations_items([H_FDL | T_FDLList]):-
    process_declarations_item(H_FDL),
    process_declarations_items(T_FDLList).

%-------------------------------------------------------------------------------

process_declarations_item(comment):-
    !.

process_declarations_item(title(_Title)):-
    !.

process_declarations_item(end):-
    !.


process_declarations_item(ignored):-
    !.

process_declarations_item(variable(TypeId_Atom, VarId_Atom)):-
    find_root_type(TypeId_Atom, CoreTypeId_Atom),
    add_declarations_variable(CoreTypeId_Atom, VarId_Atom),
    process_identifier(VarId_Atom),
    !.

process_declarations_item(constant(ConstId_Atom, TypeId_Atom)):-
    find_root_type(TypeId_Atom, CoreTypeId_Atom),
    add_declarations_constant(CoreTypeId_Atom, ConstId_Atom),
    process_identifier(ConstId_Atom),
    !.

process_declarations_item(type(TypeId_Atom, pending)):-
    add_declarations_type(TypeId_Atom, abstract),
    process_identifier(TypeId_Atom),
    !.

process_declarations_item(type(TypeId_Atom, range(Lower_Int, Upper_Int))):-



    user:checktype(Lower_Int, RangeTypeId_Atom),
    user:checktype(Upper_Int, RangeTypeId_Atom),
    !,
    add_declarations_type(TypeId_Atom, alias(RangeTypeId_Atom)),
    process_identifier(TypeId_Atom),
    !.




process_declarations_item(type(TypeId_Atom, array(IndexTypeId_AtomList, ElementTypeId_Atom))):-
    findall(CoreIndexTypeId_Atom,
            (member(IndexTypeId_Atom, IndexTypeId_AtomList),
             find_root_type(IndexTypeId_Atom, CoreIndexTypeId_Atom)),
            CoreIndexTypeId_AtomList),
    find_root_type(ElementTypeId_Atom, CoreElementTypeId_Atom),

    get_declarations_type(OtherTypeId_Atom, array(CoreIndexTypeId_AtomList, CoreElementTypeId_Atom)),
    \+ OtherTypeId_Atom = TypeId_Atom,
    add_declarations_type(TypeId_Atom, alias(OtherTypeId_Atom)),
    process_identifier(TypeId_Atom),

    atom_concat('mk__', TypeId_Atom, Function_Atom),
    add_declarations_unbounded_function(TypeId_Atom,
                               Function_Atom,
                               mk_array),
    !.

process_declarations_item(type(TypeId_Atom, array(IndexTypeId_AtomList, ElementTypeId_Atom))):-
    findall(CoreIndexTypeId_Atom,
            (member(IndexTypeId_Atom, IndexTypeId_AtomList),
             find_root_type(IndexTypeId_Atom, CoreIndexTypeId_Atom)),
            CoreIndexTypeId_AtomList),
    find_root_type(ElementTypeId_Atom, CoreElementTypeId_Atom),

    add_declarations_type(TypeId_Atom, array(CoreIndexTypeId_AtomList, CoreElementTypeId_Atom)),
    process_identifier(TypeId_Atom),
    atom_concat('mk__', TypeId_Atom, Function_Atom),
    add_declarations_unbounded_function(TypeId_Atom,
                               Function_Atom,
                               mk_array),
    !.

process_declarations_item(type(TypeId_Atom, enumeration(EnumId_AtomList))):-
    process_identifier(TypeId_Atom),
    process_declarations_enumerations(TypeId_Atom, EnumId_AtomList),
    add_declarations_type(TypeId_Atom, enumeration(EnumId_AtomList)),
    !.

process_declarations_item(type(TypeId_Atom, record(FieldList))):-
    findall(field(CoreFieldTypeId_Atom, FieldId_Atom),
            (member(field(FieldTypeId_Atom, FieldId_Atom), FieldList),
             find_root_type(FieldTypeId_Atom, CoreFieldTypeId_Atom)),
            CoreFieldList),

    add_declarations_type(TypeId_Atom, record(CoreFieldList)),
    process_identifier(TypeId_Atom),
    process_declarations_record_fields(TypeId_Atom, FieldList),

    atom_concat('mk__', TypeId_Atom, Function_Atom),
    add_declarations_unbounded_function(TypeId_Atom,
                               Function_Atom,
                               mk_record),
    !.

process_declarations_item(type(TypeId_Atom, sequence(ElementTypeId_Atom))):-
    find_root_type(ElementTypeId_Atom, CoreElementTypeId_Atom),
    get_declarations_type(OtherTypeId_Atom, sequence(CoreElementTypeId_Atom)),
    \+ OtherTypeId_Atom = TypeId_Atom,
    add_declarations_type(TypeId_Atom, alias(OtherTypeId_Atom)),
    process_identifier(TypeId_Atom),


    op(20,fy,TypeId_Atom),
    !.

process_declarations_item(type(TypeId_Atom, sequence(ElementTypeId_Atom))):-
    find_root_type(ElementTypeId_Atom, CoreElementTypeId_Atom),
    add_declarations_type(TypeId_Atom, sequence(CoreElementTypeId_Atom)),
    process_identifier(TypeId_Atom),


    op(20,fy,TypeId_Atom),
    !.

process_declarations_item(type(TypeId_Atom, set(ElementTypeId_Atom))):-
    find_root_type(ElementTypeId_Atom, CoreElementTypeId_Atom),
    get_declarations_type(OtherTypeId_Atom, set(CoreElementTypeId_Atom)),
    \+ OtherTypeId_Atom = TypeId_Atom,
    add_declarations_type(TypeId_Atom, alias(OtherTypeId_Atom)),
    process_identifier(TypeId_Atom),


    op(20,fy,TypeId_Atom),
    !.

process_declarations_item(type(TypeId_Atom, set(ElementTypeId_Atom))):-
    find_root_type(ElementTypeId_Atom, CoreElementTypeId_Atom),
    add_declarations_type(TypeId_Atom, set(CoreElementTypeId_Atom)),
    process_identifier(TypeId_Atom),


    op(20,fy,TypeId_Atom),
    !.

process_declarations_item(type(TypeId_Atom, alias(AliasTypeId_Atom))):-
    add_declarations_type(TypeId_Atom, alias(AliasTypeId_Atom)),
    process_identifier(TypeId_Atom),
    !.

process_declarations_item(function(ReturnTypeId_Atom, Function_Atom, [])):-
    find_root_type(ReturnTypeId_Atom, CoreReturnTypeId_Atom),
    add_declarations_constant(CoreReturnTypeId_Atom, Function_Atom),
    process_identifier(Function_Atom),
    !.

process_declarations_item(function(ReturnTypeId_Atom, Function_Atom, ArgTypeId_AtomList)):-
    findall(CoreArgTypeId_Atom,
            (member(ArgTypeId_Atom, ArgTypeId_AtomList),
             find_root_type(ArgTypeId_Atom, CoreArgTypeId_Atom)),
            CoreArgTypeId_AtomList),
    find_root_type(ReturnTypeId_Atom, CoreReturnTypeId_Atom),

    add_declarations_function(CoreReturnTypeId_Atom,
                     Function_Atom,
                     CoreArgTypeId_AtomList),
    process_identifier(Function_Atom),
    !.

process_declarations_item(Standardised_FDL):-
    throw_error('Unexpected declarations construct: ~w\n', Standardised_FDL),
                !.

%-------------------------------------------------------------------------------

process_declarations_enumerations(_TypeId_Atom, []):-
    !.

process_declarations_enumerations(TypeId_Atom,
                         [H_EnumId_Atom | T_EnumId_AtomList]):-
    add_declarations_constant(TypeId_Atom,
                     H_EnumId_Atom),
    process_identifier(H_EnumId_Atom),
    process_declarations_enumerations(TypeId_Atom,
                             T_EnumId_AtomList).

%-------------------------------------------------------------------------------

process_declarations_record_fields(_RecordTypeId_Atom, []):-
    !.






process_declarations_record_fields(RecordTypeId_Atom,
                          [field(FieldTypeId_Atom, FieldId_Atom)]):-
    atom_concat('upf_', FieldId_Atom, UpdateFieldFunction_Atom),
    atom_concat('fld_', FieldId_Atom, AccessFieldFunction_Atom),

    standardise_declarations_items([UpdateFieldFunction_Atom,
                           AccessFieldFunction_Atom],
                          [StandardisedUpdateFieldFunction_Atom,
                           StandardisedAccessFieldFunction_Atom]),
    process_identifier_records(StandardisedUpdateFieldFunction_Atom),
    process_identifier_records(StandardisedAccessFieldFunction_Atom),
    find_root_type(FieldTypeId_Atom, CoreFieldTypeId_Atom),
    add_declarations_function(RecordTypeId_Atom,
                     StandardisedUpdateFieldFunction_Atom,
                     [RecordTypeId_Atom, CoreFieldTypeId_Atom]),
    add_declarations_function(CoreFieldTypeId_Atom,
                     StandardisedAccessFieldFunction_Atom,
                     [RecordTypeId_Atom]),

    current_record_field_number(UniqueFieldId_Int),
    UninstantiatedUpdate_FunctorN=..[StandardisedUpdateFieldFunction_Atom, U1_Var, U2_Var],
    add_declarations_record_function(UniqueFieldId_Int,
                            UninstantiatedUpdate_FunctorN,
                            update,
                            FieldId_Atom,
                            [U1_Var, U2_Var],
                            RecordTypeId_Atom),
    UninstantiatedAccess_FunctorN=..[StandardisedAccessFieldFunction_Atom, A1_Var],
    add_declarations_record_function(UniqueFieldId_Int,
                            UninstantiatedAccess_FunctorN,
                            access,
                            FieldId_Atom,
                            [A1_Var],
                            RecordTypeId_Atom),
    !.

process_declarations_record_fields(RecordTypeId_Atom,
                          [field(FieldTypeId_Atom, FieldId_Atom) | T_FieldList]):-
    atom_concat('upf_', FieldId_Atom, UpdateFieldFunction_Atom),
    atom_concat('fld_', FieldId_Atom, AccessFieldFunction_Atom),




    standardise_declarations_items([UpdateFieldFunction_Atom,
                           AccessFieldFunction_Atom],
                          [StandardisedUpdateFieldFunction_Atom,
                           StandardisedAccessFieldFunction_Atom]),
    process_identifier_records(StandardisedUpdateFieldFunction_Atom),
    process_identifier_records(StandardisedAccessFieldFunction_Atom),
    find_root_type(FieldTypeId_Atom, CoreFieldTypeId_Atom),
    add_declarations_function(RecordTypeId_Atom,
                     StandardisedUpdateFieldFunction_Atom,
                     [RecordTypeId_Atom, CoreFieldTypeId_Atom]),

    add_declarations_function(CoreFieldTypeId_Atom,
                     StandardisedAccessFieldFunction_Atom,
                     [RecordTypeId_Atom]),

    current_record_field_number(UniqueFieldId_Int),
    UninstantiatedUpdate_FunctorN=..[StandardisedUpdateFieldFunction_Atom, U1_Var, U2_Var],
    add_declarations_record_function(UniqueFieldId_Int,
                            UninstantiatedUpdate_FunctorN,
                            update,
                            FieldId_Atom,
                            [U1_Var, U2_Var],
                            RecordTypeId_Atom),
    UninstantiatedAccess_FunctorN=..[StandardisedAccessFieldFunction_Atom, A1_Var],
    add_declarations_record_function(UniqueFieldId_Int,
                            UninstantiatedAccess_FunctorN,
                            access,
                            FieldId_Atom,
                            [A1_Var],
                            RecordTypeId_Atom),


    increment_current_record_field_number(_UniqueFieldId_Int),

    process_declarations_record_fields(RecordTypeId_Atom, T_FieldList).

%-------------------------------------------------------------------------------

increment_current_record_field_number(M) :-
    retract(current_record_field_number(N)),
    M is N+1,
    asserta(current_record_field_number(M)),
    !.

%-------------------------------------------------------------------------------







% Return core alias or self in none.
find_root_type(TypeId_Atom, AliasTypeId_Atom) :-
    get_declarations_type(TypeId_Atom,
                          alias(AliasTypeId_Atom)),
        !.

find_root_type(TypeId_Atom, TypeId_Atom) :-
    !.

%===============================================================================
% process_identifier(+Identifier_Atom).
% process_identifier_records(+Identifier_Atom).
%===============================================================================





process_identifier(Identifier_Atom):-
    process_identifier_x(Identifier_Atom, not_record),
    !.

process_identifier_records(Identifier_Atom):-
    process_identifier_x(Identifier_Atom, is_record),
    !.



save_used_identifier(NV, _Whatever):-
    process_identifier_x(NV, not_record),
    !.

%-------------------------------------------------------------------------------

% Check to see if identifier has already been seen.
process_identifier_x(Identifier_Atom, not_record):-
    get_declarations_used_identifier(Identifier_Atom),
    !,
    implode_separator_content_list('',
                                   ['Identifier declared multiple times - ',
                                    Identifier_Atom,
                                    '\n',
                                    '\n*** ERROR - ',
                                    'CANNOT CONTINUE: Simplification terminated.\n'],
                                   Content_Atom),
    throw_error(Content_Atom, []).


process_identifier_x(Identifier_Atom, _Any):-
    built_in_ident(Identifier_Atom),
    !,
    implode_separator_content_list('',
                                   ['Identifier reserved or already predeclared - ',
                                    Identifier_Atom,
                                    '\n',
                                    '\n*** ERROR - ',
                                    'CANNOT CONTINUE: Simplification terminated.\n'],
                                   Content_Atom),
    throw_error(Content_Atom, []).

process_identifier_x(Identifier_Atom, _Any):-
    add_declarations_used_identifier(Identifier_Atom),
    !.

%-------------------------------------------------------------------------------

built_in_ident(update).
built_in_ident(element).
built_in_ident(set).
built_in_ident(succ).
built_in_ident(pred).
built_in_ident(first).
built_in_ident(last).
built_in_ident(nonfirst).
built_in_ident(nonlast).
built_in_ident(abs).
built_in_ident(sqr).
built_in_ident(odd).
built_in_ident(div).
built_in_ident(mod).
built_in_ident(subset_of).
built_in_ident(strict_subset_of).
built_in_ident(true).
built_in_ident(false).
built_in_ident(integer).
built_in_ident(boolean).
built_in_ident(real).
built_in_ident(in).
built_in_ident(not_in).
built_in_ident(and).
built_in_ident(or).
built_in_ident(not).
built_in_ident(xor).
built_in_ident(rem).


:- set_prolog_flag(double_quotes, codes).

%###############################################################################
% END-OF-FILE
