Commit a0becb65 authored by FAGES Francois's avatar FAGES Francois
parents 8f337ac7 5ad28081
......@@ -3,6 +3,7 @@ MODULES=$(shell sed -n -E 's/^[+-] (.*\.pl)$$/\1/p' toc.org) \
$(ADDITIONAL_MODULES)
# load_test_files/1 should make this useless, but I cannot find how to use it
TEST_MODULES=$(wildcard $(MODULES:.pl=.plt))
VERSION=4.0.$(shell date +%Y%m%d)
$(foreach var, CC PLBASE PLCFLAGS PLLDFLAGS PLLIB, \
$(eval \
......@@ -32,7 +33,7 @@ biocham: platform/current swipl-biocham $(MODULES) toc.org Makefile
biocham_debug: platform/current swipl-biocham $(MODULES) $(TEST_MODULES) \
toc.org Makefile
$(SWIPL) -o biocham_debug \
--goal=initialize -c $(MODULES) $(TEST_MODULES)
--goal='(leash(-all),initialize)' -c $(MODULES) $(TEST_MODULES)
swipl-biocham: swipl-biocham.o \
modules/graphviz/graphviz_swiprolog.o \
......@@ -73,3 +74,43 @@ clean:
- rm biocham_tests
- rm swipl-biocham
- rm swipl-biocham.o
biocham-src.tar.gz: $(MODULES) $(TEST_MODULES) toc.org Makefile
mkdir tmp/
mkdir tmp/biocham/
cp $(MODULES) $(TEST_MODULES) toc.org Makefile swipl-biocham.c \
tmp/biocham/
mkdir tmp/biocham/platform/
mkdir tmp/biocham/platform/Darwin/
cp platform/Darwin/platform.pl tmp/biocham/platform/Darwin/
mkdir tmp/biocham/platform/Linux/
cp platform/Linux/platform.pl tmp/biocham/platform/Linux/
mkdir tmp/biocham/modules/
mkdir tmp/biocham/modules/graphviz/
cp modules/graphviz/graphviz.pl tmp/biocham/modules/graphviz/
cp modules/graphviz/graphviz.plt tmp/biocham/modules/graphviz/
cp modules/graphviz/graphviz_swiprolog.c tmp/biocham/modules/graphviz/
cp modules/graphviz/graphviz_swiprolog.h tmp/biocham/modules/graphviz/
cp modules/graphviz/Makefile tmp/biocham/modules/graphviz/
mkdir tmp/biocham/modules/graphviz/examples/
cp modules/graphviz/examples/* tmp/biocham/modules/graphviz/examples/
mkdir tmp/biocham/modules/sbml/
cp modules/sbml/sbml.pl tmp/biocham/modules/sbml/
cp modules/sbml/sbml.plt tmp/biocham/modules/sbml/
cp modules/sbml/sbml_swiprolog.c tmp/biocham/modules/sbml/
cp modules/sbml/sbml_swiprolog.h tmp/biocham/modules/sbml/
cp modules/sbml/sbml_utils.pl tmp/biocham/modules/sbml/
cp modules/sbml/Makefile tmp/biocham/modules/sbml/
mkdir tmp/biocham/modules/sbml/examples/
cp modules/sbml/examples/* tmp/biocham/modules/sbml/examples/
tar -czf biocham-src.tar.gz -C tmp/ biocham/
rm -rf tmp/
test-biocham-src: biocham-src.tar.gz
mkdir tmp/
tar -xf biocham-src.tar.gz -C tmp/
make -C tmp/biocham/
rm -rf tmp/
distribute: biocham-src.tar.gz
./distribute.sh "$(VERSION)"
......@@ -11,7 +11,7 @@
version('4.0').
copyright(
'Copyright (C) 2003-2015 Inria, EPI Lifeware, Paris-Rocquencourt, France'
'Copyright (C) 2003-2016 Inria, EPI Lifeware, Saclay-Île de France, France'
).
license('GNU GPL 2').
......
......@@ -25,15 +25,33 @@ simplify(In, Out) :-
simplify_aux(In, Out) :-
additive_block(In, Blocks),
!,
simplify_blocks(additive_block, additive_index, rebuild_additive_coef, Blocks, CoefSubBlocks),
simplify_blocks(additive_block, additive_index, Blocks, ReducedSubBlocks),
maplist(rebuild_additive_coef, ReducedSubBlocks, CoefSubBlocks),
rebuild_additive_blocks(CoefSubBlocks, Out).
simplify_aux(In, Out) :-
multiplicative_block(In, Blocks),
!,
simplify_blocks(multiplicative_block, multiplicative_index, rebuild_multiplicative_coef, Blocks, CoefSubBlocks),
simplify_blocks(multiplicative_block, multiplicative_index, Blocks, ReducedSubBlocks),
map_blocks(rebuild_multiplicative_coef, ReducedSubBlocks, CoefSubBlocks),
compute_product(CoefSubBlocks, CoefSubBlocksComputed),
rebuild_multiplicative_blocks(CoefSubBlocksComputed, Out).
rebuild_multiplicative_blocks(CoefSubBlocksComputed, OutCoef),
(
extract_coefficient(OutCoef, Coef, SubOut),
Coef < 0
->
CoefOpp is - Coef,
(
CoefOpp = 1
->
OutOpp = SubOut
;
insert_coef(SubOut, CoefOpp, OutOpp)
),
Out = - OutOpp
;
Out = OutCoef
).
simplify_aux(log(exp(Expr)), Out) :-
!,
......@@ -75,15 +93,17 @@ simplify_aux(In, Out) :-
).
simplify_blocks(Block, Index, RebuildCoef, Blocks, CoefSubBlocks) :-
simplify_blocks(Block, Index, Blocks, ReducedSubBlocks) :-
gather_loop(Block, Blocks, SubBlocks),
maplist(Index, SubBlocks, IndexedSubBlocks),
sort(4, @=<, IndexedSubBlocks, SortedSubBlocks),
check_cleaned(arithmetic_rules:canonical/3),
gather_indexed(SortedSubBlocks),
reduce_blocks(IndexedSubBlocks, ReducedSubBlocks),
clean(arithmetic_rules:canonical/3),
map_blocks(RebuildCoef, ReducedSubBlocks, CoefSubBlocks).
with_clean(
[arithmetic_rules:canonical/3],
(
arithmetic_rules:gather_indexed(SortedSubBlocks),
arithmetic_rules:reduce_blocks(IndexedSubBlocks, ReducedSubBlocks)
)
).
gather_loop(Block, Blocks, SubBlocks) :-
......@@ -100,30 +120,50 @@ gather_loop(Block, Blocks, SubBlocks) :-
compute_product([], []).
compute_product([+ N | T], Out) :-
number(N),
compute_product([B | T], Out) :-
block_number(B, N),
!,
compute_product_with_others(T, PT, Others),
P is N * PT,
P is PT * N,
(
P = 1
->
Out = Others
;
Out = [+ P | Others]
normalize_number(P, PNorm),
Out = [+ PNorm | Others]
).
compute_product([H | TIn], [H | TOut]) :-
compute_product(TIn, TOut).
block_number(B, N) :-
sign(B, Sign, C),
(
number(C),
V = C
;
C = M ^ E,
number(M),
V is M ^ E
),
(
Sign = 1
->
N = V
;
N is 1 / V
).
compute_product_with_others([], 1, []).
compute_product_with_others([+ N | T], P, Others) :-
number(N),
compute_product_with_others([B | T], P, Others) :-
block_number(B, N),
!,
compute_product_with_others(T, PT, Others),
P is N * PT.
P is PT * N.
compute_product_with_others([H | TIn], P, [H | TOut]) :-
compute_product_with_others(TIn, P, TOut).
......@@ -204,14 +244,39 @@ additive_index(H, index(Expr, Sign, Coef, Others, Canonical)) :-
canonical_expression(Others, Canonical).
extract_coefficient(C, C, 1) :-
number(C),
!.
extract_coefficient(- CA, COpp, A) :-
extract_coefficient(CA, C, A),
!,
COpp is - C.
extract_coefficient(+ CA, C, A) :-
extract_coefficient(CA, C, A),
!.
extract_coefficient(A * B, A, B) :-
number(A).
number(A),
!.
extract_coefficient(A / B, A, 1 / B) :-
number(A),
!.
extract_coefficient(A * B, B, A) :-
number(B).
number(B),
!.
extract_coefficient(A / B, BInv, A) :-
number(B),
!,
BInv is 1 / B.
extract_coefficient(CA * B, C, A * B) :-
extract_coefficient(CA, C, A).
extract_coefficient(CA, C, A),
!.
extract_coefficient(A * CB, C, A * B) :-
extract_coefficient(CB, C, B).
......@@ -258,23 +323,49 @@ canonical_expression(In, Out) :-
term_morphism(arithmetic_rules:canonical_expression, In, Out).
rebuild_additive_coef(Block, Value) :-
rebuild_additive_coef(SignedBlock, Value) :-
sign(SignedBlock, Sign, Block),
(
Block = (Coef : Expr)
->
SignedCoef is Sign * Coef,
(
Coef = 1
SignedCoef = 1
->
Value = Expr
Value = + Expr
;
Expr = 1
->
Value = Coef
Value = + SignedCoef
;
insert_coef(Expr, Coef, Value)
(
extract_coefficient(Expr, OtherCoef, SubExpr)
->
FullCoef is SignedCoef * OtherCoef
;
FullCoef = SignedCoef,
SubExpr = Expr
),
(
FullCoef < 0
->
NewSign = -1,
NewCoef is - FullCoef
;
NewSign = 1,
NewCoef = FullCoef
),
(
NewCoef = 1
->
UnsignedValue = SubExpr
;
insert_coef(SubExpr, NewCoef, UnsignedValue)
),
sign(Value, NewSign, UnsignedValue)
)
;
Value = Block
Value = + Block
).
......@@ -282,7 +373,18 @@ insert_coef(A * B, Coef, Result * B) :-
!,
insert_coef(A, Coef, Result).
insert_coef(A, Coef, Coef * A).
insert_coef(A, Coef, Result) :-
(
Coef > 0,
Coef < 1
->
CoefInv is 1 / Coef,
normalize_number(CoefInv, CoefInvNorm),
Result = A / CoefInvNorm
;
normalize_number(Coef, CoefNorm),
Result = CoefNorm * A
).
rebuild_multiplicative_coef(Block, Value) :-
......@@ -412,7 +514,7 @@ sign(+ A, 1, A).
sign(- A, -1, A).
additive_block(+ A, [-A]).
additive_block(+ A, [+A]).
additive_block(- A, [-A]).
......@@ -420,6 +522,9 @@ additive_block(A + B, [+A, +B]).
additive_block(A - B, [+A, -B]).
multiplicative_block(+ A, [+A]).
multiplicative_block(- A, [+(-1), +A]).
multiplicative_block(A * B, [+A, +B]).
......@@ -588,3 +693,18 @@ always_positive(A / B) :-
always_positive(A / B) :-
always_negative(A),
always_negative(B).
normalize_number(N, Norm) :-
(
F is float_fractional_part(N),
(
F = 0
;
F = 0.0
)
->
Norm is truncate(N)
;
Norm = N
).
......@@ -383,45 +383,68 @@ generate_body_item_stream(SourceStream, Stream, Type) :-
close_grammar(Stream),
!
;
(
Clause = (:- doc(Contents))
;
Clause = (:- devdoc(Contents)),
Type = devdoc
)
generate_clause(Stream, Clause, Variables, VariableNames, Type)
->
write_doc(Stream, Contents),
nl(Stream)
true
;
Clause = (:- grammar(Grammar))
->
close_grammar(Stream),
nb_setval(current_grammar, Grammar),
make_id(Grammar, Id),
format(
Stream,
'<table id="~a"><tr><td>~a ::= </td><td>\n',
[Id, Grammar]
)
throw(error(generate_doc(Clause), generate_body_item_stream))
),
fail
).
generate_clause(Stream, Clause, Variables, VariableNames, Type) :-
(
(
Clause = (:- doc(Contents))
;
nb_getval(current_grammar, Grammar),
Grammar \= none,
(
Clause = (Head :- Body)
;
Clause = Head,
Body = true
),
Head =.. [Grammar, Item]
->
instantiate_grammar_body(Body),
format(Stream, '<div>| <code>~w</code></div>', [Item])
Clause = (:- devdoc(Contents)),
Type = devdoc
)
->
write_doc(Stream, Contents),
nl(Stream)
;
Clause = (:- Predicate),
(
Predicate = biocham(_)
;
close_grammar(Stream),
name_variables_and_anonymous(Variables, VariableNames),
generate_body_item_clause(Clause, Stream, Type)
Predicate = biocham_silent(_)
)
->
write_doc_item(Predicate, Stream, Type)
;
Clause = (:- grammar(Grammar))
->
close_grammar(Stream),
nb_setval(current_grammar, Grammar),
make_id(Grammar, Id),
format(
Stream,
'<table id="~a"><tr><td>~a ::= </td><td>\n',
[Id, Grammar]
)
;
nb_getval(current_grammar, Grammar),
Grammar \= none,
(
Clause = (Head :- Body)
;
Clause = Head,
Body = true
),
fail
Head =.. [Grammar, Item]
->
instantiate_grammar_body(Body),
format(Stream, '<div>| <code>~w</code></div>', [Item])
;
Clause = (:- _)
->
true
;
close_grammar(Stream),
name_variables_and_anonymous(Variables, VariableNames),
generate_body_item_clause(Clause, Stream, Type)
).
......@@ -477,8 +500,8 @@ instantiate_grammar_body(Item) :-
generate_body_item_clause(Clause, Stream, Type) :-
predicate_info(Clause, ArgumentTypes, BiochamCommand, Doc),
(
predicate_info(Clause, ArgumentTypes, Options, BiochamCommand, Doc),
(
BiochamCommand = yes
;
......@@ -519,7 +542,25 @@ generate_body_item_clause(Clause, Stream, Type) :-
write_doc_item(DocItem, Stream, Type)
)
),
write(Stream, '</div>')
write(Stream, '\n</div>'),
(
Options = []
->
true
;
write(Stream, '\n<div>\n<h6>Options.</h6>\n<dl>'),
\+ (
member(option(Option, OptionType, OptionDoc), Options),
\+ (
format(Stream, '\n<dt><var>~a</var>: ', [Option]),
write_type(OptionType, '', Stream),
write(Stream, '</dt>\n<dd>'),
write_doc(Stream, OptionDoc),
write(Stream, '</dd>')
)
),
write(Stream, '\n</dl>\n</div>')
)
;
true
).
......@@ -546,96 +587,118 @@ write_argument(Argument, Doc) :-
(
argument_type(Argument, Type)
->
write_type(Type, Argument, Doc)
;
write_var(Doc, Argument)
).
write_type(Type, Argument, Doc) :-
(
Type = '*'(Name = Value)
->
make_id(Name, NameId),
make_id(Value, ValueId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub> = <a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub> =
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, ValueId, Value, NameId, Name, ValueId, Value]
)
;
Type = '*'(Name: Value)
->
make_id(Name, NameId),
make_id(Value, ValueId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub>: <a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub>:
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, ValueId, Value, NameId, Name, ValueId, Value]
)
;
Type = '*'([Name])
->
make_id(Name, NameId),
format(
Doc,
'[<a href="#~a">~a</a><sub>1</sub>],
...,
[<a href="#~a">~a</a><sub><var>n</var></sub>]',
[NameId, Name, NameId, Name]
)
;
Type = '*'(Name)
->
make_id(Name, NameId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, NameId, Name]
)
;
Type = '='(ItemType)
->
make_id(ItemType, Id),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub> = ... =
<a href="#~a">~a</a><sub><var>n</var></sub>',
[Id, ItemType, Id, ItemType]
)
;
Type = {ItemType}
->
make_id(ItemType, Id),
format(
Doc,
'{<a href="#~a">~a</a><sub>1</sub>, ...,
<a href="#~a">~a</a><sub><var>n</var></sub>}',
[Id, ItemType, Id, ItemType]
)
;
Type = [ItemType]
->
make_id(ItemType, Id),
format(
Doc,
'[<a href="#~a">~a</a><sub>1</sub>, ...,
<a href="#~a">~a</a><sub><var>n</var></sub>]',
[Id, ItemType, Id, ItemType]
)
;
camel_case(Type, CamelCaseType),
make_id(Type, Id),
format(atom(TypeLink), '<a href="#~a">~a</a>', [Id, Type]),
(
Type = '*'(Name = Value)
->
make_id(Name, NameId),
make_id(Value, ValueId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub> = <a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub> =
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, ValueId, Value, NameId, Name, ValueId, Value]
)
;
Type = '*'([Name])
->
make_id(Name, NameId),
format(
Doc,
'[<a href="#~a">~a</a><sub>1</sub>],
...,
[<a href="#~a">~a</a><sub><var>n</var></sub>]',
[NameId, Name, NameId, Name]
)
;
Type = '*'(Name)
->
make_id(Name, NameId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, NameId, Name]
)
;
Type = '='(ItemType)
->
make_id(ItemType, Id),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub> = ... =
<a href="#~a">~a</a><sub><var>n</var></sub>',
[Id, ItemType, Id, ItemType]
(
Argument = ''
;
Argument = CamelCaseType
)
;
Type = {ItemType}
->
make_id(ItemType, Id),
format(
Doc,
'{<a href="#~a">~a</a><sub>1</sub>, ...,
<a href="#~a">~a</a><sub><var>n</var></sub>}',
[Id, ItemType, Id, ItemType]
)
make_id(Type, Id),
write(Doc, TypeLink)
;
Type = [ItemType]
atom_concat(CamelCaseType, Suffix, Argument)
->
make_id(ItemType, Id),
format(
Doc,
'[<a href="#~a">~a</a><sub>1</sub>, ...,
<a href="#~a">~a</a><sub><var>n</var></sub>]',
[Id, ItemType, Id, ItemType]
'~a<sub><var>~a</var></sub>',
[TypeLink, Suffix]
)
;
camel_case(Type, CamelCaseType),
make_id(Type, Id),
format(atom(TypeLink), '<a href="#~a">~a</a>', [Id, Type]),
(
Argument = CamelCaseType
->
make_id(Type, Id),
write(Doc, TypeLink)
;
atom_concat(CamelCaseType, Suffix, Argument)
->
format(
Doc,
'~a<sub><var>~a</var></sub>',
[TypeLink, Suffix]
)
;
format(Doc, '<var>~a</var>: ~a', [Argument, TypeLink])
)
format(Doc, '<var>~a</var>: ~a', [Argument, TypeLink])
)
;
write_var(Doc, Argument)
).
write_var(Doc, Var) :-
format(Doc, '<var>~a</var>', [Var]).
......@@ -703,24 +766,61 @@ write_doc_item(devdoc(DocBody), Stream, Type) :-
).
write_doc_item(biocham_silent(Command), _Stream, _Type) :-
print(Command),
nl,
command(Command).
write_doc_item(biocham(Command), Stream, _Type) :-
print(Command),
nl,