34
   35:- module('$qlf',
   36          [ qcompile/1,            37            qcompile/2,            38            '$qload_file'/5,       39            '$qload_stream'/5      40          ]).   41
   42
   43                    46
   47:- meta_predicate
   48    qcompile(:),
   49    qcompile(:, +).   50
   51:- thread_local
   52    qinclude/1.
   59qcompile(M:Files) :-
   60    qcompile_(Files, M, []).
   61qcompile(M:Files, Options) :-
   62    '$option'(include(Incl), Options),
   63    !,
   64    '$must_be'(oneof(atom, include, [user]), Incl),
   65    setup_call_cleanup(
   66        asserta(qinclude(Incl), Ref),
   67        qcompile_(Files, M, Options),
   68        erase(Ref)).
   69qcompile(M:Files, Options) :-
   70    qcompile_(Files, M, Options).
   71
   72qcompile_([], _, _) :- !.
   73qcompile_([H|T], M, Options) :-
   74    !,
   75    qcompile_(H, M, Options),
   76    qcompile_(T, M, Options).
   77qcompile_(FileName, Module, Options) :-
   78    absolute_file_name(FileName,
   79                       [ file_type(prolog),
   80                         access(read),
   81                         file_errors(fail),
   82                         solutions(all)
   83                       ], Absolute),
   84    file_name_extension(ABase, PlExt, Absolute),
   85    \+ user:prolog_file_type(PlExt, qlf),
   86    !,
   87    once(user:prolog_file_type(QlfExt, qlf)),
   88    file_name_extension(ABase, QlfExt, Qlf),
   89    load_files(Module:Absolute, ['$qlf'(Qlf)|Options]).
   90qcompile_(FileName, _Module, _Options) :-
   91    absolute_file_name(FileName,
   92                       [ file_type(prolog),
   93                         access(read)
   94                       ], Absolute),
   95    file_name_extension(_ABase, PlExt, Absolute),
   96    user:prolog_file_type(PlExt, qlf),
   97    throw(error(permission_error(compile, qlf, Absolute),
   98                context(qcompile/1, 'No Prolog source file'))).
  104'$qload_file'(File, Module, Action, LoadedModule, Options) :-
  105    setup_call_cleanup(
  106        open(File, read, In, [type(binary)]),
  107        setup_call_cleanup(
  108            '$save_lex_state'(LexState, Options),
  109            '$qload_stream'(In, Module,
  110                            Action, LoadedModule, Options),
  111            '$restore_lex_state'(LexState)),
  112        close(In)).
  113
  114'$qload_stream'(In, Module, loaded, LoadedModule, Options) :-
  115    '$qlf_load'(Module:In, LM),
  116    check_is_module(LM, In, Options),
  117    (   atom(LM)
  118    ->  LoadedModule = LM
  119    ;   LoadedModule = Module
  120    ).
  121
  122check_is_module(LM, In, Options) :-
  123    \+ atom(LM),
  124    '$option'(must_be_module(true), Options, false),
  125    !,
  126    stream_property(In, file_name(File)),
  127    throw(error(domain_error(module_file, File), _)).
  128check_is_module(_, _, _)