359 lines
11 KiB
Prolog
359 lines
11 KiB
Prolog
|
|
:- module('$toplevel', ['$repl'/1, consult/1, use_module/1, use_module/2]).
|
|
|
|
:- use_module(library(charsio)).
|
|
:- use_module(library(lists)).
|
|
:- use_module(library(si)).
|
|
|
|
'$repl'([_|Args]) :-
|
|
maplist(use_list_of_modules, Args),
|
|
false.
|
|
'$repl'(_) :- repl.
|
|
|
|
use_list_of_modules(Mod0) :-
|
|
atom_chars(Mod, Mod0),
|
|
catch(use_module(Mod), E, print_exception(E)).
|
|
|
|
repl :-
|
|
catch(read_and_match, E, print_exception(E)),
|
|
false. %% this is for GC, until we get actual GC.
|
|
repl :-
|
|
repl.
|
|
|
|
read_and_match :-
|
|
'$read_query_term'(Term, VarList),
|
|
instruction_match(Term, VarList).
|
|
|
|
% make compile_batch, a system routine, callable.
|
|
compile_batch :- '$compile_batch'.
|
|
|
|
instruction_match(Term, VarList) :-
|
|
( var(Term) ->
|
|
throw(error(instantiation_error, repl/0))
|
|
;
|
|
Term = [Item] -> !,
|
|
( atom(Item) ->
|
|
( Item == user ->
|
|
catch(compile_batch, E, print_exception_with_check(E))
|
|
; consult(Item)
|
|
)
|
|
;
|
|
catch(throw(error(type_error(atom, Item), repl/0)),
|
|
E,
|
|
print_exception_with_check(E))
|
|
)
|
|
;
|
|
submit_query_and_print_results(Term, VarList)
|
|
).
|
|
|
|
:- use_module(library(iso_ext)).
|
|
|
|
% auxiliary predicates, so that using them in setup_call_cleanup/3 works
|
|
get_b_value(B) :- '$get_b_value'(B).
|
|
clear_attribute_goals :- '$clear_attribute_goals'.
|
|
|
|
submit_query_and_print_results(Term0, VarList) :-
|
|
( expand_goals(Term0, Term) -> true
|
|
; Term0 = Term
|
|
),
|
|
setup_call_cleanup(bb_put('$first_answer', true),
|
|
( get_b_value(B), call(Term), write_eqs_and_read_input(B, VarList),
|
|
!
|
|
; % clear attribute goal lists, which may be populated by
|
|
% copy_term/3 prior to failure.
|
|
clear_attribute_goals, write('false.'), nl
|
|
),
|
|
bb_put('$first_answer', false)).
|
|
|
|
needs_bracketing(Value, Op) :-
|
|
catch((functor(Value, F, _),
|
|
current_op(EqPrec, EqSpec, Op),
|
|
current_op(FPrec, _, F)),
|
|
_,
|
|
false),
|
|
( EqPrec < FPrec -> true
|
|
; '$quoted_token'(F) -> true
|
|
; atom_length(F, 1), graphic_token_char(F) -> true
|
|
; EqPrec == FPrec,
|
|
memberchk(EqSpec, [fx,xfx,yfx])
|
|
).
|
|
|
|
write_goal(G, VarList, MaxDepth) :-
|
|
( G = (Var = Value) ->
|
|
write(Var),
|
|
write(' = '),
|
|
( needs_bracketing(Value, (=)) ->
|
|
write('('),
|
|
write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
|
|
write(')')
|
|
; write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
|
|
)
|
|
; G == [] ->
|
|
write('true')
|
|
; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
|
|
).
|
|
|
|
write_last_goal(G, VarList, MaxDepth) :-
|
|
( G = (Var = Value) ->
|
|
write(Var),
|
|
write(' = '),
|
|
( needs_bracketing(Value, (=)) ->
|
|
write('('),
|
|
write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
|
|
write(')')
|
|
; write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
|
|
( trailing_period_is_ambiguous(Value) ->
|
|
write(' ')
|
|
; true
|
|
)
|
|
)
|
|
; G == [] ->
|
|
write('true')
|
|
; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
|
|
).
|
|
|
|
write_eq((G1, G2), VarList, MaxDepth) :-
|
|
!,
|
|
write_goal(G1, VarList, MaxDepth),
|
|
write(', '),
|
|
write_eq(G2, VarList, MaxDepth).
|
|
write_eq(G, VarList, MaxDepth) :-
|
|
write_last_goal(G, VarList, MaxDepth).
|
|
|
|
graphic_token_char(C) :-
|
|
memberchk(C, ['#', '$', '&', '*', '+', '-', '.', ('/'), ':',
|
|
'<', '=', '>', '?', '@', '^', '~', ('\\')]).
|
|
|
|
list_last_item([C], C) :- !.
|
|
list_last_item([_|Cs], D) :-
|
|
list_last_item(Cs, D).
|
|
|
|
trailing_period_is_ambiguous(Value) :-
|
|
atom(Value),
|
|
atom_chars(Value, ValueChars),
|
|
list_last_item(ValueChars, Char),
|
|
ValueChars \== ['.'],
|
|
graphic_token_char(Char).
|
|
|
|
write_eqs_and_read_input(B, VarList) :-
|
|
charsio:extend_var_list(VarList, VarList, NewVarList, fabricated),
|
|
sort(NewVarList, SortedVarList),
|
|
'$get_b_value'(B0),
|
|
gather_goals(SortedVarList, SortedVarList, Goals),
|
|
( bb_get('$first_answer', true) ->
|
|
write(' '),
|
|
bb_put('$first_answer', false)
|
|
; true
|
|
),
|
|
( B0 == B ->
|
|
( Goals == [] ->
|
|
write('true.'), nl
|
|
; thread_goals(Goals, ThreadedGoals, (',')),
|
|
write_eq(ThreadedGoals, NewVarList, 20),
|
|
write('.'),
|
|
nl
|
|
)
|
|
; thread_goals(Goals, ThreadedGoals, (',')),
|
|
write_eq(ThreadedGoals, NewVarList, 20),
|
|
read_input(ThreadedGoals, NewVarList)
|
|
).
|
|
|
|
read_input(ThreadedGoals, NewVarList) :-
|
|
get_single_char(C),
|
|
( C = w ->
|
|
nl,
|
|
write(' '),
|
|
write_eq(ThreadedGoals, NewVarList, 0),
|
|
read_input(ThreadedGoals, NewVarList)
|
|
; C = p ->
|
|
nl,
|
|
write(' '),
|
|
write_eq(ThreadedGoals, NewVarList, 20),
|
|
read_input(ThreadedGoals, NewVarList)
|
|
; member(C, [';', ' ', n]) ->
|
|
nl, write('; '), false
|
|
; C = h ->
|
|
help_message,
|
|
read_input(ThreadedGoals, NewVarList)
|
|
; member(C, ['\n', .]) ->
|
|
nl, write('; ...'), nl
|
|
; read_input(ThreadedGoals, NewVarList)
|
|
).
|
|
|
|
help_message :-
|
|
nl, nl,
|
|
write('SPACE, "n" or ";": next solution, if any\n'),
|
|
write('RETURN or ".": stop enumeration\n'),
|
|
write('"h": display this help message\n'),
|
|
write('"w": write terms without depth limit\n'),
|
|
write('"p": print terms with depth limit\n\n').
|
|
|
|
gather_query_vars([_ = Var | Vars], QueryVars) :-
|
|
( var(Var) ->
|
|
QueryVars = [Var | QueryVars1],
|
|
gather_query_vars(Vars, QueryVars1)
|
|
; gather_query_vars(Vars, QueryVars)
|
|
).
|
|
gather_query_vars([], []).
|
|
|
|
is_a_different_variable([_ = Binding | Pairs], Value) :-
|
|
( Value == Binding, !
|
|
; is_a_different_variable(Pairs, Value)
|
|
).
|
|
|
|
gather_goals([], VarList, Goals) :-
|
|
gather_query_vars(VarList, QueryVars),
|
|
copy_term(QueryVars, QueryVars, Goals).
|
|
gather_goals([Var = Value | Pairs], VarList, Goals) :-
|
|
( ( nonvar(Value)
|
|
; is_a_different_variable(Pairs, Value)
|
|
) ->
|
|
Goals = [Var = Value | Goals0],
|
|
gather_goals(Pairs, VarList, Goals0)
|
|
; gather_goals(Pairs, VarList, Goals)
|
|
).
|
|
|
|
print_exception(E) :-
|
|
( E == error('$interrupt_thrown', repl) -> nl % print the
|
|
% exception on a
|
|
% newline to evade
|
|
% "^C".
|
|
; true
|
|
),
|
|
write_term('caught: ', [quoted(false), max_depth(20)]),
|
|
writeq(E),
|
|
nl.
|
|
|
|
print_exception_with_check(E) :-
|
|
( E = error(_, _:_) -> true % if the error source contains a line
|
|
% number, a GNU-style error message
|
|
% is expected to be printed instead.
|
|
; print_exception(E)
|
|
).
|
|
|
|
module_export(Source, PI) :-
|
|
( nonvar(PI) ->
|
|
( PI = Name / Arity ->
|
|
( var(Name) -> throw(error(instantiation_error, Source))
|
|
; integer(Arity) ->
|
|
( \+ atom(Name) -> throw(error(type_error(atom, Name), Source))
|
|
; Arity < 0 -> throw(error(domain_error(not_less_than_zero, Arity), Source))
|
|
; true
|
|
)
|
|
; throw(error(type_error(integer, Arity), Source))
|
|
)
|
|
; PI = op(Prec, Spec, Name) ->
|
|
( integer(Prec) ->
|
|
( \+ atom(Name) ->
|
|
throw(error(type_error(atom, Name), Source))
|
|
; Prec < 0 ->
|
|
throw(error(domain_error(not_less_than_zero, Prec), Source))
|
|
; Prec > 1200 ->
|
|
throw(error(domain_error(operator_precision, Prec), Source))
|
|
; memberchk(Spec, [xfy, yfx, xfx, fx, fy, yf, xf])
|
|
; throw(error(domain_error(operator_specification, Spec), Source))
|
|
)
|
|
; throw(error(type_error(integer, Prec), Source))
|
|
)
|
|
; throw(error(type_error(module_export, PI), Source))
|
|
)
|
|
; throw(error(instantiation_error, Source))
|
|
).
|
|
|
|
consult(Item) :-
|
|
( atom(Item) -> use_module(Item)
|
|
; throw(error(type_error(atom, Item), consult/1))
|
|
).
|
|
|
|
use_module(Module) :-
|
|
( nonvar(Module) ->
|
|
( Module = library(Filename) -> '$use_module'(Filename)
|
|
; atom(Module) -> '$use_module_from_file'(Module)
|
|
; throw(error(invalid_module_specifier, use_module/1))
|
|
)
|
|
; throw(error(instantiation_error, use_module/1))
|
|
).
|
|
|
|
use_module(Module, QualifiedExports) :-
|
|
( nonvar(Module) ->
|
|
( list_si(QualifiedExports) ->
|
|
maplist('$module_export'(use_module/2), QualifiedExports) ->
|
|
( Module = library(Filename) ->
|
|
'$use_qualified_module'(Filename, QualifiedExports)
|
|
; atom(Module) ->
|
|
'$use_qualified_module_from_file'(Module, QualifiedExports)
|
|
; throw(error(invalid_module_specifier, use_module/2))
|
|
)
|
|
; throw(error(type_error(list, QualifiedExports), use_module/2))
|
|
)
|
|
; throw(error(instantiation_error, use_module/2))
|
|
).
|
|
|
|
|
|
% expand goals in initialization directives.
|
|
user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :-
|
|
nonvar(Term0),
|
|
Term0 = (:- initialization(Goals)),
|
|
expand_goals(Goals, ExpandedGoals),
|
|
Goals \== ExpandedGoals.
|
|
|
|
module_expand_goal(UnexpandedGoals, ExpandedGoals) :-
|
|
( '$module_of'(Module, UnexpandedGoals),
|
|
'$module_exists'(Module),
|
|
Module:goal_expansion(UnexpandedGoals, ExpandedGoals),
|
|
UnexpandedGoals \== ExpandedGoals ->
|
|
true
|
|
; user:goal_expansion(UnexpandedGoals, ExpandedGoals)
|
|
).
|
|
|
|
expand_goals(UnexpandedGoals, ExpandedGoals) :-
|
|
nonvar(UnexpandedGoals),
|
|
var(ExpandedGoals),
|
|
( module_expand_goal(UnexpandedGoals, Goals) ->
|
|
true
|
|
; Goals = UnexpandedGoals
|
|
),
|
|
( Goals = (Goal0, Goals0) ->
|
|
( expand_goals(Goal0, Goal1) ->
|
|
expand_goals(Goals0, Goals1),
|
|
thread_goals(Goal1, ExpandedGoals, Goals1, (','))
|
|
; expand_goals(Goals0, Goals1),
|
|
ExpandedGoals = (Goal0, Goals1)
|
|
)
|
|
; Goals = (Goals0 -> Goals1) ->
|
|
expand_goals(Goals0, ExpandedGoals0),
|
|
expand_goals(Goals1, ExpandedGoals1),
|
|
ExpandedGoals = (ExpandedGoals0 -> ExpandedGoals1)
|
|
; Goals = (Goals0 ; Goals1) ->
|
|
expand_goals(Goals0, ExpandedGoals0),
|
|
expand_goals(Goals1, ExpandedGoals1),
|
|
ExpandedGoals = (ExpandedGoals0 ; ExpandedGoals1)
|
|
; Goals = (\+ Goals0) ->
|
|
expand_goals(Goals0, Goals1),
|
|
ExpandedGoals = (\+ Goals1)
|
|
; thread_goals(Goals, ExpandedGoals, (','))
|
|
; Goals = ExpandedGoals
|
|
).
|
|
|
|
thread_goals(Goals0, Goals1, Hole, Functor) :-
|
|
nonvar(Goals0),
|
|
( Goals0 = [G | Gs] ->
|
|
( Gs == [] ->
|
|
Goals1 =.. [Functor, G, Hole]
|
|
; Goals1 =.. [Functor, G, Goals2],
|
|
thread_goals(Gs, Goals2, Hole, Functor)
|
|
)
|
|
; Goals1 =.. [Functor, Goals0, Hole]
|
|
).
|
|
|
|
thread_goals(Goals0, Goals1, Functor) :-
|
|
nonvar(Goals0),
|
|
( Goals0 = [G | Gs] ->
|
|
( Gs = [] ->
|
|
Goals1 = G
|
|
; Goals1 =.. [Functor, G, Goals2],
|
|
thread_goals(Gs, Goals2, Functor)
|
|
)
|
|
; Goals1 = Goals0
|
|
).
|