shithub: pprolog

ref: 5fe8b9865cfbd7388b8f6355a73b1436d40cfb1e
dir: /loader.pl/

View raw version
:- module(loader, []).

start(Args) :-
	catch((load_module_from_file('/sys/lib/prolog/repl.pl'), ReplLoaded = true), E, (print_exception(E), ReplLoaded = false)),
	( ReplLoaded = true-> repl:repl(Args) ).

print_exception(E) :-
	write('Caught exception while loading /sys/lib/prolog/repl.pl: '),
	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, _),
	close(Stream).

read_and_handle_terms(Stream, Module0, Module) :-
	( read_one_term(Stream, Term, Singles)
	-> handle_term(Term, Singles, Module0, Module1),
	   read_and_handle_terms(Stream, Module1, Module)
	; Module = Module0
	).

read_one_term(Stream, Term, Singles) :-
	consume_whitespace(Stream),
	peek_char(Stream, NextCh),
	NextCh \= end_of_file,
	read_term(Stream, Term, [singletons(Singletons)]),
	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, Singles, 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, 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(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(module(NewModule, Exports), Module, 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, Singles) :-
	write('Warning: singleton variables in '), 
	write(PI),
	write(': '),
	write(Singles),
	write('.'),
	nl.

ensure_loads(_) :- fail.

ensure_load(F) :-
	( ensure_loads(F)
	-> true
	; loader:asserta(ensure_loads(F)), load_module_from_file(F)
	).