1:- module(axiom, [
    2      axiom_to_entity/2
    3   ]).    4
    5axiom_to_entity(Axiom, substitution(Left, Right)) :-
    6   string_concat('Substitution: ', Eq, Axiom),
    7   !,
    8   split_string(Eq, "=", " ", [Left, Right]).
    9
   10axiom_to_entity(Axiom, name(Name)) :-
   11   string_concat('proper name: ', Name, Axiom),
   12   !.
   13
   14axiom_to_entity(Axiom, verb(VerbWithS)) :-
   15   string_concat('transitive verb: ', Verb, Axiom),
   16   !,
   17   string_concat(Verb, "s", VerbWithS).
   18
   19axiom_to_entity(Axiom, fact(F)) :-
   20   split_string(Axiom, ":", " ", [FactNumber, F]),
   21   number_string(_, FactNumber),
   22   !.
   23
   24axiom_to_entity(Axiom, countable_noun(E)) :-
   25   string_concat("countable common noun: ", E, Axiom),
   26   !.
   27
   28axiom_to_entity(Axiom, mass_common_noun(E)) :-
   29   string_concat("mass common noun: ", E, Axiom),
   30   !.
   31
   32axiom_to_entity(Axiom, axiom(Axiom)) :- !