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, Absolute,
   79                       [ file_type(source),
   80                         access(read),
   81                         file_errors(fail),
   82                         solutions(all)
   83                       ]),
   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, Absolute,
   92                       [ file_type(prolog),
   93                         access(read)
   94                       ]),
   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        qopen(File, In, Ref),
  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        qclose(In, Ref)).
  119qopen(File, In, Ref) :-
  120    open(File, read, In, [type(binary)]),
  121    asserta(system:'$load_input'(File, In), Ref).
  122
  123qclose(In, Ref) :-
  124    erase(Ref),
  125    close(In).
  126
  127'$qload_stream'(In, Module, loaded, LoadedModule, Options) :-
  128    '$qlf_load'(Module:In, LM),
  129    check_is_module(LM, In, Options),
  130    (   atom(LM)
  131    ->  LoadedModule = LM
  132    ;   LoadedModule = Module
  133    ).
  134
  135check_is_module(LM, In, Options) :-
  136    \+ atom(LM),
  137    '$option'(must_be_module(true), Options, false),
  138    !,
  139    stream_property(In, file_name(File)),
  140    throw(error(domain_error(module_file, File), _)).
  141check_is_module(_, _, _)