ref: 4fba3e66dce0d167d2031a0d1f1f6f4571cbd981
dir: /loader.pl/
:- module(loader, []).
start(Args) :-
( bootstrap([system, loader, repl])
-> call(repl:repl(Args))
; write('Booting pprolog failed..'), halt
).
bootstrap([]) :- '$delete_module'(user), '$new_empty_module'(user).
bootstrap([Mod|Mods]) :-
system_mod_path(Mod, File),
catch(load_module_from_file(File), E, (print_exception(File, E), fail)),
( Mod == system
-> '$activate_system_module'
; true
),
bootstrap(Mods).
system_mod_path(Mod, Path) :-
atom_concat('/sys/lib/prolog/', Mod, Path0),
atom_concat(Path0, '.pl', Path).
print_exception(File, E) :-
write('Caught exception while loading '),
write(File),
write(': '),
write(E),
nl.
load_module_from_file(File) :-
( atom_concat(_, '.pl', File)
-> open(File, read, Stream)
; atom_concat(File, '.pl', File1),
open(File1, read, Stream)
),
read_and_handle_terms(Stream, user, Module),
close(Stream),
run_initialization_goals(Module).
run_initialization_goals(Module) :-
( retract(initialization_goals(Module, Goal)),
catch(Module:Goal, E, print_initialization_goal_error(Module, Goal, E)),
!,
run_initialization_goals(Module)
; true
).
print_initialization_goal_error(Module, Goal, Exception) :-
write('Initialization goal threw exception:'),
nl,
write(' Module: '), write(Module), nl,
write(' Goal: '), write(Goal), nl,
write(' Exception: '), write(Exception), nl,
nl.
read_and_handle_terms(Stream, Module0, Module) :-
( read_one_term(Stream, Term, Module0, Singles)
-> handle_term(Term, Singles, Module0, Module1),
read_and_handle_terms(Stream, Module1, Module)
; Module = Module0
).
read_one_term(Stream, Term, Module0, Singles) :-
consume_whitespace(Stream),
peek_char(Stream, NextCh),
NextCh \= end_of_file,
( Module0 == system
-> read_term(Stream, Term, [singletons(Singletons)])
; Module0:read_term(Stream, Term, [singletons(Singletons)])
% For all other modules than system use Mod:read_term, to use the correct operators
),
singleton_names(Singletons, Singles).
whitespace(' ').
whitespace(' ').
whitespace('
').
consume_whitespace(S) :-
peek_char(S, Ch),
( whitespace(Ch)
-> get_char(S, _), consume_whitespace(S)
; true
).
singleton_names([], []).
singleton_names([Name = _|Rest0], Names) :-
singleton_names(Rest0, Rest),
( atom_concat('_', _, Name)
-> Names = Rest
; Names = [Name|Rest]
).
handle_term(:- Directive, _, Module, NewModule) :-
!,
handle_directive(Directive, Module, NewModule).
handle_term(Head :- Body, Singles, Module, Module) :-
!,
handle_clause(Head, Body, Singles, Module).
handle_term(Head --> Body, _, Module, Module) :-
!,
write('DCG RULE: '),
write(Head --> Body),
nl.
handle_term(Head, Singles, Module, Module) :-
handle_clause(Head, true, Singles, Module).
handle_clause(Head, Body, Singletons, Module) :-
functor(Head, Name, Arity),
PredicateIndicator = Name / Arity,
warn_singletons(PredicateIndicator, Module, Singletons),
Module:'$insert_clause'(Head :- Body).
handle_directive(dynamic(PI), Module, Module) :-
is_nonvar(PI),
( list(PI)
-> [First|Rest] = PI,
handle_directive(dynamic(First), Module, Module),
handle_directive(dynamic(Rest), Module, Module)
; is_predicate_indicator(PI),
Name / Arity = PI,
functor(Tmp, Name, Arity),
Module:asserta(Tmp),
Module:retract(Tmp)
).
handle_directive(op(Priority, Specifier, Operator), Module, Module) :-
Module:op(Priority, Specifier, Operator).
handle_directive(initialization(T), Module, Module) :-
loader:assertz(initialization_goals(Module, T)).
handle_directive(include(F), Module, NewModule) :-
open(F, read, S),
read_and_handle_terms(S, Module, NewModule),
close(S).
handle_directive(ensure_loaded(F), Module, Module) :-
ensure_load(F).
handle_directive(set_prolog_flag(Flag, Value), Module, Module) :-
Module:set_prolog_flag(Flag, Value).
handle_directive(module(NewModule, _Exports), _, NewModule) :-
is_atom(NewModule),
'$new_empty_module'(NewModule).
% Do something about the exports as well.
handle_directive(D, Module, Module) :-
write('Cannot handle directive: '),
write(D),
nl.
warn_singletons(_, _, []).
warn_singletons(PI, Module, Singles) :-
write('Warning: singleton variables '),
write(Singles),
write(' in '),
write(Module:PI),
write('.'),
nl.
:- dynamic(ensure_loads/1).
ensure_loads(_) :- fail.
ensure_load(F) :-
( ensure_loads(F)
-> true
; loader:asserta(ensure_loads(F)), load_module_from_file(F)
).