types.pl 3.44 KB
Newer Older
Thierry Martinez's avatar
Thierry Martinez committed
1 2 3
:- module(
  types,
  [
Thierry Martinez's avatar
Thierry Martinez committed
4 5 6
    type/2,
    predicate_info/4,
    check_type/3
Thierry Martinez's avatar
Thierry Martinez committed
7 8 9 10
  ]
).

type(_, _).
Thierry Martinez's avatar
Thierry Martinez committed
11 12 13 14 15 16


predicate_info((Head :- Body), ArgumentTypes, BiochamCommand, Doc) :-
  functor(Head, Functor, Arity),
  Head =.. [Functor | Arguments],
  length(ArgumentTypes, Arity),
Thierry Martinez's avatar
Thierry Martinez committed
17 18 19 20 21 22 23 24 25
  collect_info(Body, Arguments, ArgumentTypes, BiochamCommand0, Doc),
  (
    var(BiochamCommand0)
  ->
    BiochamCommand0 = no
  ;
    true
  ),
  BiochamCommand = BiochamCommand0.
Thierry Martinez's avatar
Thierry Martinez committed
26 27 28 29 30 31 32

predicate_info(Functor/Arity, ArgumentTypes, BiochamCommand, Doc) :-
  functor(Head, Functor, Arity),
  once(clause(Head, Body)),
  predicate_info((Head :- Body), ArgumentTypes, BiochamCommand, Doc).


Thierry Martinez's avatar
Thierry Martinez committed
33 34
collect_info(biocham_command, _Arguments, _ArgumentTypes, yes, []) :-
  !.
Thierry Martinez's avatar
Thierry Martinez committed
35

Thierry Martinez's avatar
Thierry Martinez committed
36 37
collect_info(biocham_command(*), _Arguments, _ArgumentTypes, variantargs, []) :-
  !.
Thierry Martinez's avatar
Thierry Martinez committed
38

Thierry Martinez's avatar
Thierry Martinez committed
39
collect_info(type(Argument, Type), Arguments, ArgumentTypes, _, []) :-
Thierry Martinez's avatar
Thierry Martinez committed
40 41
  !,
  once(nth0_eqq(Index, Arguments, Argument)),
Thierry Martinez's avatar
Thierry Martinez committed
42
  nth0(Index, ArgumentTypes, Type).
Thierry Martinez's avatar
Thierry Martinez committed
43

Thierry Martinez's avatar
Thierry Martinez committed
44 45 46 47 48
collect_info(DocItem, _Arguments, _ArgumentTypes, _BiochamCommand, Doc) :-
  (
    DocItem = doc(_)
  ;
    DocItem = devdoc(_)
Thierry Martinez's avatar
Thierry Martinez committed
49 50 51 52
  ;
    DocItem = biocham(_)
  ;
    DocItem = biocham_silent(_)
Thierry Martinez's avatar
Thierry Martinez committed
53
  ),
Thierry Martinez's avatar
Thierry Martinez committed
54
  !,
Thierry Martinez's avatar
Thierry Martinez committed
55
  Doc = [DocItem].
Thierry Martinez's avatar
Thierry Martinez committed
56

Thierry Martinez's avatar
Thierry Martinez committed
57 58 59 60 61 62 63
collect_info((A, B), Arguments, ArgumentTypes, BiochamCommand, Doc) :-
  !,
  collect_info(A, Arguments, ArgumentTypes, BiochamCommand, DocA),
  append(DocA, DocB, Doc),
  collect_info(B, Arguments, ArgumentTypes, BiochamCommand, DocB).

collect_info(_, _Arguments, _ArgumentTypes, _BiochamCommand, []).
Thierry Martinez's avatar
Thierry Martinez committed
64 65 66 67 68 69 70 71 72 73


check_type(atom, Object, NewObject) :-
  !,
  check_atom(Object, NewObject).

check_type(number, Number, NewNumber) :-
  !,
  check_number(Number, NewNumber).

Thierry Martinez's avatar
Thierry Martinez committed
74 75 76
check_type(term, Term, Term) :-
  !.

Thierry Martinez's avatar
Thierry Martinez committed
77 78 79 80 81 82 83 84 85 86
check_type(integer, Number, NewNumber) :-
  !,
  check_number(Number, NewNumber),
  integer(NewNumber).

check_type('='(SubType), Equals, NewList) :-
  !,
  equals_to_list(Equals, List),
  check_type([SubType], List, NewList).

Thierry Martinez's avatar
Thierry Martinez committed
87 88 89 90 91 92
check_type('='(LeftType, RightType), Equal, NewLeft = NewRight) :-
  !,
  Equal = (Left = Right),
  check_type(LeftType, Left, NewLeft),
  check_type(RightType, Right, NewRight).

Thierry Martinez's avatar
Thierry Martinez committed
93 94 95 96 97
check_type({SubType}, Set, NewList) :-
  !,
  set_to_list(Set, List),
  check_type([SubType], List, NewList).

Thierry Martinez's avatar
Thierry Martinez committed
98 99 100 101
check_type('*'(SubType), List, NewList) :-
  !,
  check_type([SubType], List, NewList).

Thierry Martinez's avatar
Thierry Martinez committed
102 103
check_type([SubType], List, NewList) :-
  !,
Thierry Martinez's avatar
Thierry Martinez committed
104
  check_type_list(List, SubType, NewList).
Thierry Martinez's avatar
Thierry Martinez committed
105 106 107 108 109 110 111 112 113 114 115 116 117

check_type(Grammar, Item, NewItem) :-
  (
    Grammar = solution
  ->
    patch_solution(Item, Item0)
  ;
    Item0 = Item
  ),
  Head =.. [Grammar, Item0],
  NewHead =.. [Grammar, NewItem],
  (
    clause(NewHead, NewBody),
118
    copy_term((NewHead, NewBody), (Head, Body)),
Thierry Martinez's avatar
Thierry Martinez committed
119 120 121 122 123
    catch(
      check_grammar_body(Body, NewBody),
      error(expected(_)),
      fail
    )
Thierry Martinez's avatar
Thierry Martinez committed
124 125
  ->
    true
Thierry Martinez's avatar
Thierry Martinez committed
126 127 128 129 130
  ;
    throw(error(expected(Grammar)))
  ).


Thierry Martinez's avatar
Thierry Martinez committed
131 132 133 134 135 136 137
check_type_list([], _Type, []).

check_type_list([HeadIn| TailIn], Type, [HeadOut | TailOut]) :-
  check_type(Type, HeadIn, HeadOut),
  check_type_list(TailIn, Type, TailOut).


Thierry Martinez's avatar
Thierry Martinez committed
138 139 140 141 142
check_atom(Atom, NewAtom) :-
  format(atom(NewAtom), '~w', [Atom]).


check_number(Number, NewNumber) :-
143
  catch(NewNumber is Number, error(_, _), fail).
Thierry Martinez's avatar
Thierry Martinez committed
144 145 146 147 148 149 150


check_grammar_body((A, B), (NewA, NewB)) :-
  !,
  check_grammar_body(A, NewA),
  check_grammar_body(B, NewB).

Thierry Martinez's avatar
Thierry Martinez committed
151 152 153 154
check_grammar_body(list(Grammar, Item), list(Grammar, NewItem)) :-
  !,
  check_type([Grammar], Item, NewItem).

Thierry Martinez's avatar
Thierry Martinez committed
155 156 157 158
check_grammar_body(Goal, NewGoal) :-
  Goal =.. [Grammar, Item],
  NewGoal =.. [Grammar, NewItem],
  check_type(Grammar, Item, NewItem).