% -----------------------------------------------------------------------------
%  (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
%-------------------------------------------------------------------------------
% Provides access to all information related to declarations. Most of this
% information will be retrieved from the provided declarations file.
%###############################################################################

:- module(data__declarations, [get_declarations_used_identifier/1,
                               add_declarations_used_identifier/1,
                               get_declarations_variable/2,
                               add_declarations_variable/2,
                               get_declarations_constant/2,
                               add_declarations_constant/2,
                               get_declarations_unbounded_function/3,
                               add_declarations_unbounded_function/3,
                               get_declarations_function/3,
                               add_declarations_function/3,
                               get_declarations_type/2,
                               add_declarations_type/2,
                               get_declarations_record_function/6,
                               add_declarations_record_function/6,

                               pre_calculate_legacy_fdl/0,

                               type/2,
                               find_core_type/2,
                               function/3,
                               record_function/6,

                               type_alias/2,
                               enumeration/2,
                               mk__function_name/3,
                               function_template/3]).


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

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

:- set_prolog_flag(double_quotes, chars).

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

:- add_type('TypeAttributes',
            [abstract,
             alias('AliasTypeId_Atom'),
             array('IndexTypeId_AtomList', 'ElementTypeId_Atom'),
             enumeration('EnumId_AtomList'),
             record('FieldList'),
             sequence('ElementTypeId_Atom'),
             set('ElementTypeId_Atom')]).

:- add_type('UnboundedClass',
            [mk_array,
             mk_record]).

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

:- add_type('Mode',
            [update,
             access]).




:- add_type('InternalUnboundedClass',
            [array,
             record]).

:- add_type('InternalTypeAttributes',
            [abstract,
             array('IndexTypeId_AtomList', 'ElementTypeId_Atom'),
             enumerated,
             record('FieldIdFieldTypeId_ListList'),
             sequence('ElementTypeId_Atom'),
             set('ElementTypeId_Atom')]).


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

:- add_state(get_declarations_used_identifier,
             get_declarations_used_identifier('Id_Atom')).
:- dynamic(get_declarations_used_identifier/1).

:- add_state(get_declarations_variable,
             get_declarations_variable('TypeId_Atom', 'VarId_Atom')).
:- dynamic(get_declarations_variable/2).

:- add_state(get_declarations_constant,
             get_declarations_constant('TypeId_Atom', 'ConstId_Atom')).
:- dynamic(get_declarations_constant/2).

:- add_state(get_declarations_unbounded_function,
             get_declarations_unbounded_function('TypeId_Atom',
                                                 'Function_Atom',
                                                 'UnboundedClass')).
:- dynamic(get_declarations_unbounded_function/3).

:- add_state(get_declarations_function,
             get_declarations_function('ReturnTypeId_Atom',
                                       'Function_Atom',
                                       'ArgTypeId_AtomList')).
:- dynamic(get_declarations_function/3).

:- add_state(get_declarations_type,
             get_declarations_type('TypeId_Atom',
                                   'TypeAttributes')).
:- dynamic(get_declarations_type/2).










:- add_state(get_declarations_record_function,
             get_declarations_record_function('UniqueFieldId_Int',
                                              'Uninstantiated_FunctorN',
                                              'Mode',
                                              'FieldId_Atom',
                                              'Args_VarList',
                                              'TypeId_Atom')).
:- dynamic(get_declarations_record_function/6).







:- add_state(function,
            [function('Function_Atom',
                      'ArgTypeId_AtomList',
                      'ReturnTypeId_Atom')]).
:- dynamic(function/3).

:- add_state(record_function,
             record_function('UniqueFieldId_Int',
                             'Uninstantiated_FunctorN',
                             'Mode',
                             'FieldId_Atom',
                             'Args_VarList',
                             'TypeId_Atom')).
:- dynamic(record_function/6).

:- add_state(mk__function_name,
             mk__function_name('Function_Atom',
                               'TypeId_Atom',
                               'InternalUnboundedClass')).
:- dynamic(mk__function_name/3).

:- add_state(type_alias,
             type_alias('TypeId_Atom', 'AliasTypeId_Atom')).
:- dynamic(type_alias/2).


:- add_state(type,
             type('TypeId_Atom', 'InternalTypeAttributes')).
:- dynamic(type/2).

:- add_state(enumeration,
             enumeration('TypeId_Atom', 'EnumId_AtomList')).
:- dynamic(enumeration/2).

:- add_state(function_template,
             function_template('Function_Pred',
                               'VarList',
                               'Function_Atom')).
:- dynamic(function_template/3).


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


%===============================================================================
% Add.
%===============================================================================

add_declarations_used_identifier(Id_Atom):-
    assertz(get_declarations_used_identifier(Id_Atom)),
    !.

add_declarations_variable(TypeId_Atom,
                 VarId_Atom):-
    assertz(get_declarations_variable(TypeId_Atom,
                             VarId_Atom)),
    !.

add_declarations_constant(TypeId_Atom,
                 ConstId_Atom):-
    assertz(get_declarations_constant(TypeId_Atom,
                             ConstId_Atom)),
    !.

add_declarations_unbounded_function(TypeId_Atom,
                           Function_Atom,
                           UnboundedClass):-
    assertz(get_declarations_unbounded_function(TypeId_Atom,
                                       Function_Atom,
                                       UnboundedClass)),
    !.

add_declarations_function(ReturnTypeId_Atom,
                 Function_Atom,
                 ArgTypeId_AtomList):-
    assertz(get_declarations_function(ReturnTypeId_Atom,
                             Function_Atom,
                             ArgTypeId_AtomList)),
    !.

add_declarations_type(TypeId_Atom,
             TypeAttributes):-
    assertz(get_declarations_type(TypeId_Atom,
                         TypeAttributes)),
    !.

add_declarations_record_function(UniqueFieldId_Int,
                        Uninstantiated_FunctorN,
                        Mode,
                        FieldId_Atom,
                        Args_VarList,
                        TypeId_Atom):-
    assertz(get_declarations_record_function(UniqueFieldId_Int,
                                    Uninstantiated_FunctorN,
                                    Mode,
                                    FieldId_Atom,
                                    Args_VarList,
                                    TypeId_Atom)),
    !.
%===============================================================================


%===============================================================================
% Refactor.
%===============================================================================















pre_calculate_legacy_fdl:-
    calculate_function,
    calculate_record_function,
    calculate_mk__function_name,
    calculate_type_alias,
    calculate_type,
    calculate_enumeration,
    calculate_function_template,
    !.

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

calculate_function:-
    get_declarations_function(ReturnTypeId_Atom,
                     Function_Atom,
                     ArgTypeId_AtomList),
    assertz(function(Function_Atom, ArgTypeId_AtomList, ReturnTypeId_Atom)),
    fail.

calculate_function:-
    !.

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

calculate_record_function:-
    get_declarations_record_function(UniqueFieldId_Int,
                            Uninstantiated_FunctorN,
                            Mode,
                            FieldId_Atom,
                            Args_VarList,
                            TypeId_Atom),
    assertz(record_function(UniqueFieldId_Int,
                           Uninstantiated_FunctorN,
                           Mode,
                           FieldId_Atom,
                           Args_VarList,
                           TypeId_Atom)),
    fail.

calculate_record_function:-
    !.

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

calculate_mk__function_name:-
    get_declarations_unbounded_function(TypeId_Atom,
                               Function_Atom,
                               mk_array),
    assertz(mk__function_name(Function_Atom, TypeId_Atom, array)),
    fail.

calculate_mk__function_name:-
    get_declarations_unbounded_function(TypeId_Atom,
                               Function_Atom,
                               mk_record),
    assertz(mk__function_name(Function_Atom, TypeId_Atom, record)),
    fail.

calculate_mk__function_name:-
    !.

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

calculate_type_alias:-
    get_declarations_type(TypeId_Atom,
                 alias(AliasTypeId_Atom)),
    assert(type_alias(TypeId_Atom, AliasTypeId_Atom)),
    fail.

calculate_type_alias:-
    !.

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

calculate_type:-
    get_declarations_type(TypeId_Atom,
                 record(FieldList)),
    findall([FieldId_Atom, FieldTypeId_Atom],
            member(field(FieldTypeId_Atom, FieldId_Atom), FieldList),
            FIELD_LIST),
    assert(type(TypeId_Atom, record(FIELD_LIST))),
    fail.

calculate_type:-
    get_declarations_type(TypeId_Atom,
                 abstract),
    assert(type(TypeId_Atom, abstract)),
    fail.

calculate_type:-
    get_declarations_type(TypeId_Atom,
                 array(IndexTypeId_AtomList, ElementTypeId_Atom)),
    assert(type(TypeId_Atom, array(IndexTypeId_AtomList, ElementTypeId_Atom))),
    fail.

calculate_type:-
    get_declarations_type(TypeId_Atom,
                 enumeration(_EnumId_AtomList)),
    assert(type(TypeId_Atom, enumerated)),
    fail.

calculate_type:-
    get_declarations_type(TypeId_Atom,
                 sequence(ElementTypeId_Atom)),
    assert(type(TypeId_Atom, sequence(ElementTypeId_Atom))),
    fail.

calculate_type:-
    get_declarations_type(TypeId_Atom,
                 set(ElementTypeId_Atom)),
    assert(type(TypeId_Atom, set(ElementTypeId_Atom))),
    fail.

calculate_type:-
    !.

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

calculate_enumeration:-
    get_declarations_type(TypeId_Atom,
                 enumeration(EnumId_AtomList)),
    assert(enumeration(TypeId_Atom, EnumId_AtomList)),
    fail.

calculate_enumeration:-
    !.

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

calculate_function_template:-
    function(Function_Atom,ArgTypeId_AtomList,_ReturnTypeId_Atom),
    atom_chars(Function_Atom, Function_CharList),
    \+ append("upf_", _, Function_CharList),
    \+ append("fld_", _, Function_CharList),
    save_function_template(Function_Atom, ArgTypeId_AtomList),
    fail.

calculate_function_template:-
    !.

save_function_template(FUNCTION, ARG_TYPES) :-
        length(ARG_TYPES, LENGTH),
        form_function_var_list(LENGTH, VAR_LIST),
        FUNCTION_CALL =.. [FUNCTION|VAR_LIST],
        assertz(function_template(FUNCTION_CALL, VAR_LIST, FUNCTION)),
        !.

form_function_var_list(1,  [_]) :- !.
form_function_var_list(2,  [_,_]) :- !.
form_function_var_list(3,  [_,_,_]) :- !.
form_function_var_list(4,  [_,_,_,_]) :- !.
form_function_var_list(5,  [_,_,_,_,_]) :- !.
form_function_var_list(6,  [_,_,_,_,_,_]) :- !.
form_function_var_list(7,  [_,_,_,_,_,_,_]) :- !.
form_function_var_list(8,  [_,_,_,_,_,_,_,_]) :- !.
form_function_var_list(9,  [_,_,_,_,_,_,_,_,_]) :- !.
form_function_var_list(10, [_,_,_,_,_,_,_,_,_,_]) :- !.
form_function_var_list(N, [_,_,_,_,_|X]) :-
        N>10, N1 is N-5, !, form_function_var_list(N1, X), !.

% Should not get here.
form_function_var_list(0, []) :- !.

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
















%===============================================================================
% find_core_type(+TYPE, -CORE_TYPE).
%-------------------------------------------------------------------------------
% Return the core type of TYPE as CORE_TYPE, or if TYPE does not have a
% CORE_TYPE, return TYPE.
%===============================================================================

find_core_type(TYPE, CORE_TYPE) :-
        type_alias(TYPE, CORE_TYPE),
        !.
find_core_type(TYPE, TYPE) :- !.
%===============================================================================

:- set_prolog_flag(double_quotes, codes).


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