namespace.pl 2.79 KB
Newer Older
Thierry Martinez's avatar
Thierry Martinez committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
:- module(
  namespace,
  [
    % Public API
    identifier_kind/3,
    check_identifier_kind/2,
    check_no_free_identifiers/0,
    update_identifier_kinds/1
  ]
).


:- devdoc('\\section{Public API}').


:- dynamic(identifier_kind/3).


check_identifier_kind(Ident, NeededKind) :-
  single_model(ModelId),
  (
    identifier_kind(ModelId, Ident, Kind),
    Kind \= free,
    NeededKind \= Kind
  ->
    throw(
      error(
        already_defined_with_another_kind(Ident, Kind, NeededKind),
        check_identifier_kind
      )
    )
  ;
    true
  ).


prolog:error_message(
  already_defined_with_another_kind(Ident, Kind, NeededKind)
) -->
  {
    format(
      atom(Message),
      '~a cannot be ~a because it is already used as ~a.',
      [Ident, NeededKind, Kind]
    )
  },
  [Message].



check_no_free_identifiers :-
  single_model(ModelId),
  findall(
    Ident,
    identifier_kind(ModelId, Ident, free),
    FreeIdents
  ),
  (
    FreeIdents = []
  ->
    true
  ;
    throw(error(not_defined(FreeIdents), check_no_free_identifiers))
  ).


prolog:error_message(not_defined(FreeIdents)) -->
  {
    with_output_to(
      atom(Message),
      (
        FreeIdents = [FreeIdent]
      ->
        format('~a is not defined.', [FreeIdent])
      ;
        write_successes(
          member(FreeIdent, FreeIdents),
          write(', '),
          write(FreeIdent)
        ),
        write(' are not defined.')
      )
    )
  },
  [Message].


update_identifier_kinds(ModelId) :-
  retractall(identifier_kind(ModelId, _, _)),
  \+ (
    item([parent: ModelId, kind: parameter, item: parameter(Object = _Value)]),
    \+ (
      assertz(identifier_kind(ModelId, Object, parameter))
    )
  ),
  \+ (
    item([parent: ModelId, kind: function, item: function(Head = _Body)]),
    Head =.. [Object | _],
    \+ (
      assertz(identifier_kind(ModelId, Object, function))
    )
  ),
103 104
  enumerate_objects_and_free(ModelId, reaction),
  enumerate_objects_and_free(ModelId, influence),
Thierry Martinez's avatar
Thierry Martinez committed
105
  \+ (
106 107 108 109 110 111 112 113 114 115 116 117 118
    directly_inherits_from(SubModelId, ModelId),
    \+ (
      update_identifier_kinds(SubModelId)
    )
  ).


:- devdoc('\\section{Private predicates}').


enumerate_objects_and_free(ModelId, Kind) :-
  \+ (
    item([parent: ModelId, kind: Kind, item: Item]),
Thierry Martinez's avatar
Thierry Martinez committed
119 120
    \+ (
      grammar_iter(
121
        Kind,
Thierry Martinez's avatar
Thierry Martinez committed
122
        [object: namespace:set_kind(ModelId, object)],
123
        Item
Thierry Martinez's avatar
Thierry Martinez committed
124 125 126 127
      )
    )
  ),
  \+ (
128
    item([parent: ModelId, kind: Kind, item: Item]),
Thierry Martinez's avatar
Thierry Martinez committed
129 130
    \+ (
      grammar_iter(
131
        Kind,
Thierry Martinez's avatar
Thierry Martinez committed
132
        [name: namespace:set_kind_if_not_set(ModelId, free)],
133
        Item
Thierry Martinez's avatar
Thierry Martinez committed
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
      )
    )
  ).


set_kind(ModelId, Kind, Identifier) :-
  assertz(identifier_kind(ModelId, Identifier, Kind)).


set_kind_if_not_set(ModelId, Kind, Identifier) :-
  (
    identifier_kind(ModelId, Identifier, _Kind)
  ->
    true
  ;
    set_kind(ModelId, Kind, Identifier)
  ).