1:- module(with_memory_file, [with_memory_file/3]).    2:- use_module(library(memfile)).    3
    4memory_file_to_type(Handle, atom(Atom)) :-
    5    memory_file_to_atom(Handle, Atom).
    6
    7memory_file_to_type(Handle, codes(Codes)) :-
    8    memory_file_to_codes(Handle, Codes).
    9
   10memory_file_to_type(Handle, string(String)) :-
   11    memory_file_to_string(Handle, String).
   12
   13with_memory_file(Type, Mode, Goal) :-
   14    setup_call_cleanup(
   15        (new_memory_file(Handle), open_memory_file(Handle, Mode, OutputStream)),
   16        call(Goal, OutputStream),
   17        (close(OutputStream), memory_file_to_type(Handle, Type), free_memory_file(Handle))
   18    ).
   19
   20:- begin_tests(with_memory_file).   21
   22test(with_memory_file) :-
   23    with_memory_file(atom(Atom), write, [Stream]>>write(Stream, foo)),
   24    Atom = foo,
   25    with_memory_file(string(String), write, [Stream]>>write(Stream, foo)),
   26    String = "foo",
   27    with_memory_file(codes(Codes), write, [Stream]>>write(Stream, foo)),
   28    Codes = [102, 111, 111].
   29
   30:- end_tests(with_memory_file).