1:- module(facts_to_table,
    2          [ facts_to_table/2,
    3            wd_alias2/3
    4          ]).    5
    6:- meta_predicate facts_to_table(0, +).    7
    8facts_to_table(MFact, Table) :-
    9    MFact = _:Fact,
   10    tell(Table),
   11    Fact =.. [_, Arg1|Args],
   12    setup_call_cleanup(
   13        open(Table, write, Stream, [encoding(utf8)]),
   14        with_output_to(
   15            Stream,
   16            forall(MFact,
   17                   ( writeq(Arg1),
   18                     forall(member(Arg, Args),
   19                            ( write('\t'),
   20                              write(Arg)
   21                            )),
   22                     nl
   23                   ))),
   24        close(Stream)).
   25
   26:- dynamic stored_idtable_handle/1.   27
   28idtable(Handle) :-
   29    stored_idtable_handle(Handle),
   30    !.
   31idtable(Handle) :-
   32    new_table('wd_alias.tab',
   33              [id(integer), lang(atom), name(atom)],
   34              [field_separator(0'\t), encoding(native)], Handle),
   35    assert(stored_idtable_handle(Handle)).
   36
   37wd_alias2(Id, Lang, Name) :-
   38    idtable(Handle),
   39    in_table(Handle, [id(Id), lang(Lang), name(Name)], _).
   40
   41/*
   42:- use_module('/home/edison/tmp/wd_alias').
   43
   44wd_alias_to_table(Table) :-
   45    tell(Table),
   46    aggregate_all(t(max(LId), max(LLang), max(LName)),
   47                  ( wd_alias(Id, Lang, Name),
   48                    write_length(Id,   LId,   []),
   49                    write_length(Lang, LLang, []),
   50                    write_length(Name, LName, [])
   51                  ), t(LId, LLang, LName)),
   52    Tab1 is LId,
   53    Tab2 is LId  + LLang,
   54    % Tab3 is Tab2 + LName,
   55    forall(wd_alias(Id, Lang, Name),
   56           ( % format("~d~` t~*|~s~` t~*|~s~` t~*|~n", [Id, Tab1, Lang, Tab2, Name, Tab3])
   57               format("~d~` t~*|~s~` t~*|~s~n", [Id, Tab1, Lang, Tab2, Name])
   58           )),
   59    told.
   60*/