Commit a732dd58 authored by Thierry Martinez's avatar Thierry Martinez

Namespace

parent fe0887ee
......@@ -25,6 +25,7 @@ function(FunctionList) :-
member(Function = Value, FunctionList),
\+ (
Function =.. [Functor | _Arguments],
check_identifier_kind(Functor, function),
catch(
(
find_item([kind: function, key: Functor, id: Id]),
......
......@@ -46,11 +46,14 @@
add_dependency/2,
add_file_suffix/2,
inherits/2,
inherits_from/2,
directly_inherits_from/2,
begin_command/0,
get_selection/3,
set_selection/3,
at_delete/2,
get_parent/2
get_parent/2,
get_model/2
]
).
......@@ -208,29 +211,7 @@ select_model(RefSet) :-
biocham_command,
type(RefSet, {ref}),
doc('selects some models.'),
findall(
Id,
(
member(Ref, RefSet),
(
list(Ref)
->
ranges_ids(Ref, Ids),
member(Id, Ids)
;
find_item([parent: top, key: Ref, id: Id])
),
item([id: Id, kind: Kind]),
(
Kind = model
->
true
;
throw(error(not_a_model(Kind)))
)
),
CurrentModels
),
find_model_refs(RefSet, CurrentModels),
set_current_models(CurrentModels).
......@@ -257,16 +238,14 @@ delete(Indexes) :-
inherits(Ancestors) :-
biocham_command(*),
type(Ancestors, '*'(name)),
type(Ancestors, '*'(ref)),
doc('makes the current model inherit from the given ancestor models.'),
single_model(Id),
find_model_refs(Ancestors, Models),
\+ (
member(Ancestor, Ancestors),
member(AncestorId, Models),
\+ (
find_item([kind: model, key: Ancestor, id: AncestorId]),
(
inherits(Id, AncestorId)
)
inherits(Id, AncestorId)
)
).
......@@ -348,13 +327,15 @@ add_item(Options) :-
),
not_fresh,
create_item_id(Id),
put_item(Parent0, Kind, Key, Item, Id).
put_item(Parent0, Kind, Key, Item, Id),
update_parent_model_identifier_kinds(Parent0).
replace_item(Id, Kind, Key, Item) :-
retract(item(Id, Parent, _Kind, _Item)),
retractall(key(_Key, Id)),
put_item(Parent, Kind, Key, Item, Id).
put_item(Parent, Kind, Key, Item, Id),
update_parent_model_identifier_kinds(Parent).
change_item(Options, Kind, Key, Item) :-
......@@ -605,7 +586,80 @@ add_file_suffix('bc', add_biocham_file).
inherits(Id, AncestorId) :-
assertz(directly_inherits_from(Id, AncestorId)).
(
Id = AncestorId
->
throw(error(cannot_inherit_from_itself, inherits))
;
self_or_inherits_from(Child, Id),
self_or_inherits_from(AncestorId, Parent),
inherits_from(Parent, Child)
->
throw(error(cannot_inherit_from_descendant, inherits))
;
(
item(Id, top, model, _Item0),
item(AncestorId, top, model, _Item1),
self_or_inherits_from(Child, Id),
identifier_kind(Child, Ident, Kind0),
Kind0 \= free,
identifier_kind(AncestorId, Ident, Kind1),
Kind1 \= free,
Kind0 \= Kind1
->
throw(error(kind_mismatch(Ident, Kind0, Kind1), inherits))
;
true
),
assertz(directly_inherits_from(Id, AncestorId))
).
prolog:error_message(cannot_inherit_from_itself) -->
[
'Cannot inherit from itself.'
].
prolog:error_message(already_inherits) -->
[
'There is already such an inheritance relation.'
].
prolog:error_message(cannot_inherit_from_descendant) -->
[
'Cannot inherit from descendant.'
].
prolog:error_message(
kind_mismatch(Ident, Kind, NeededKind)
) -->
{
format(
atom(Message),
'There is a mismatch between the uses of ~a: ~a and ~a.',
[Ident, Kind, NeededKind]
)
},
[Message].
inherits_from(Id, AncestorId) :-
directly_inherits_from(Id, AncestorId).
inherits_from(Id, AncestorId) :-
directly_inherits_from(Id, IntermediateAncestorId),
inherits_from(IntermediateAncestorId, AncestorId).
self_or_inherits_from(Id, Id).
self_or_inherits_from(Id, AncestorId) :-
inherits_from(Id, AncestorId).
:- dynamic(directly_inherits_from/2).
begin_command :-
......@@ -646,6 +700,17 @@ get_parent(Id, ParentId) :-
item(Id, ParentId, _, _).
get_model(Id, ModelId) :-
item(Id, ParentId, Kind, _),
(
Kind = model
->
ModelId = Id
;
get_model(ParentId, ModelId)
).
:- devdoc('\\section{Private predicates}').
......@@ -830,9 +895,6 @@ create_item_id(Id) :-
:- dynamic(selection/3).
:- dynamic(directly_inherits_from/2).
get_selection_parent(ParentOrCurrentModel, Parent) :-
(
ParentOrCurrentModel = current_model
......@@ -843,14 +905,6 @@ get_selection_parent(ParentOrCurrentModel, Parent) :-
).
inherits_from(Id, AncestorId) :-
directly_inherits_from(Id, AncestorId).
inherits_from(Id, AncestorId) :-
directly_inherits_from(Id, IntermediateAncestorId),
inherits_from(IntermediateAncestorId, AncestorId).
load_all(Suffix, InputFile) :-
current_models(OldCurrentModels),
findall(
......@@ -980,3 +1034,40 @@ not_fresh :-
:- dynamic(annotation/3).
update_parent_model_identifier_kinds(Parent) :-
(
Parent = top
->
true
;
get_model(Parent, ModelId),
update_identifier_kinds(ModelId)
).
find_model_refs(RefSet, Models) :-
findall(
Id,
(
member(Ref, RefSet),
(
list(Ref)
->
ranges_ids(Ref, Ids),
member(Id, Ids)
;
find_item([parent: top, key: Ref, id: Id])
),
item([id: Id, kind: Kind]),
(
Kind = model
->
true
;
throw(error(not_a_model(Kind)))
)
),
Models
).
:- 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))
)
),
\+ (
item([kind: reaction, item: Reaction]),
\+ (
grammar_iter(
reaction,
[object: namespace:set_kind(ModelId, object)],
Reaction
)
)
),
\+ (
item([kind: reaction, item: Reaction]),
\+ (
grammar_iter(
reaction,
[name: namespace:set_kind_if_not_set(ModelId, free)],
Reaction
)
)
),
\+ (
directly_inherits_from(SubModelId, ModelId),
\+ (
update_identifier_kinds(SubModelId)
)
).
:- devdoc('\\section{Private predicates}').
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)
).
......@@ -118,6 +118,7 @@ solve(
Time, Method, ErrorEpsilonAbsolute, ErrorEpsilonRelative, InitialStepSize,
MaximumStepSize, Precision
) :-
check_no_free_identifiers,
enumerate_variables,
convert_ode,
gather_headers(Headers),
......
......@@ -23,6 +23,7 @@ set_parameter(ParameterList) :-
\+ (
member(Parameter = Value, ParameterList),
\+ (
check_identifier_kind(Parameter, parameter),
change_item([], parameter, Parameter, parameter(Parameter = Value))
)
).
......
......@@ -101,6 +101,16 @@ prolog:error_message(not_a_reaction_model) -->
add_reaction(Kinetics, Left, Right, Reversible) :-
\+ (
(
member(_ * Object, Left)
;
member(_ * Object, Right)
),
\+ (
check_identifier_kind(Object, object)
)
),
make_reaction(Kinetics, Left, Right, Reversible, Reaction),
check_reaction_model,
add_item([kind: reaction, item: Reaction]).
......
......@@ -90,7 +90,6 @@ solution(Object) :-
object(Object).
patch_solution(A - B, Result) :-
!,
patch_solution(A, RA),
......
......@@ -24,6 +24,7 @@
** Numerical temporal properties
* Commands at Top-level
- toplevel.pl
- namespace.pl
** Loading, listing, importing and exporting models
*** Biocham files
- models.pl
......
......@@ -22,6 +22,7 @@
term_morphism/3,
substitute/4,
rewrite/3,
grammar_iter/3,
grammar_map/4,
call_subprocess/3,
with_clean/2,
......@@ -266,6 +267,54 @@ rewrite(System, In, Out) :-
).
grammar_iter(Grammar, Rules, Term) :-
Head =.. [Grammar, Term],
(
clause(Head, Body),
Body
->
true
;
throw(error(unexpected_term(Term, Grammar), grammar_iter))
),
!,
grammar_iter_aux(Body, Rules).
grammar_iter_aux(true, _Rules) :-
!.
grammar_iter_aux((A, B), Rules) :-
!,
grammar_iter_aux(A, Rules),
grammar_iter_aux(B, Rules).
grammar_iter_aux(function_application(Grammar, Term), Rules) :-
!,
Term =.. [_F | Arguments],
maplist(grammar_iter(Grammar, Rules), Arguments).
grammar_iter_aux(G, Rules) :-
G =.. [F, Argument],
(
memberchk((F: P), Rules)
->
call(P, Argument)
;
(
F = atom
;
F = number
;
F = integer
)
->
true
;
grammar_iter(F, Rules, Argument)
).
grammar_map(Grammar, Rules, In, Out) :-
ProtoHead =.. [Grammar, ProtoArg],
(
......@@ -291,17 +340,24 @@ grammar_map_aux((AIn, BIn), (AOut, BOut), Rules) :-
grammar_map_aux(AIn, AOut, Rules),
grammar_map_aux(BIn, BOut, Rules).
grammar_map_aux(
function_application(Grammar, In), function_application(Grammar, Out), Rules
) :-
!,
In =.. [F | InArguments],
Out =.. [F | OutArguments],
maplist(grammar_map(Grammar, Rules), InArguments, OutArguments).
grammar_map_aux(PIn, POut, Rules) :-
PIn =.. [F, ArgumentIn],
POut =.. [F, ArgumentOut],
(
memberchk((F: P), Rules)
->
true
call(P, ArgumentIn, ArgumentOut)
;
throw(error(unexpected_predicate(F, ArgumentIn), grammar_map))
),
call(P, ArgumentIn, ArgumentOut).
grammar_map(F, Rules, ArgumentIn, ArgumentOut)
).
call_subprocess(ExecutableFilename, Arguments, Options) :-
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment