rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

drop $ naming convention inside '' when unnecessary

Browse Source
This commit is contained in:
Mark Thom
2020-04-18 20:06:52 -06:00
parent 2c8858ff2d
commit 3438f88c1e
1 changed files with 71 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

142
src/prolog/toplevel.pl
View File

@@ -1,63 +1,63 @@
:- module('$toplevel', ['$repl'/1, consult/1, use_module/1, use_module/2]). :- module('$toplevel', [repl/1, consult/1, use_module/1, use_module/2]).
:- use_module(library(charsio)). :- use_module(library(charsio)).
:- use_module(library(lists)). :- use_module(library(lists)).
:- use_module(library(si)). :- use_module(library(si)).
'$repl'([_|Args]) :- repl([_|Args]) :-
maplist('$use_list_of_modules', Args), maplist(use_list_of_modules, Args),
false. false.
'$repl'(_) :- '$repl'. repl(_) :- repl.
'$use_list_of_modules'(Mod0) :- use_list_of_modules(Mod0) :-
atom_chars(Mod, Mod0), atom_chars(Mod, Mod0),
catch(use_module(Mod), E, '$print_exception'(E)). catch(use_module(Mod), E, print_exception(E)).
'$repl' :- repl :-
catch('$read_and_match', E, '$print_exception'(E)), catch(read_and_match, E, print_exception(E)),
false. %% this is for GC, until we get actual GC. false. %% this is for GC, until we get actual GC.
'$repl' :- repl :-
'$repl'. repl.
'$read_and_match' :- read_and_match :-
'$read_query_term'(Term, VarList), '$read_query_term'(Term, VarList),
'$instruction_match'(Term, VarList). instruction_match(Term, VarList).
% make '$compile_batch', a system routine, callable. % make compile_batch, a system routine, callable.
'$$compile_batch' :- '$compile_batch'. compile_batch :- '$compile_batch'.
'$instruction_match'(Term, VarList) :- instruction_match(Term, VarList) :-
( var(Term) -> ( var(Term) ->
throw(error(instantiation_error, repl/0)) throw(error(instantiation_error, repl/0))
; ;
Term = [Item] -> !, Term = [Item] -> !,
( atom(Item) -> ( atom(Item) ->
( Item == user -> ( Item == user ->
catch('$$compile_batch', E, '$print_exception_with_check'(E)) catch(compile_batch, E, print_exception_with_check(E))
; consult(Item) ; consult(Item)
) )
; ;
catch(throw(error(type_error(atom, Item), repl/0)), catch(throw(error(type_error(atom, Item), repl/0)),
E, E,
'$print_exception_with_check'(E)) print_exception_with_check(E))
) )
; ;
'$submit_query_and_print_results'(Term, VarList) submit_query_and_print_results(Term, VarList)
). ).
'$submit_query_and_print_results'(Term0, VarList) :- submit_query_and_print_results(Term0, VarList) :-
( expand_goals(Term0, Term) -> true ( expand_goals(Term0, Term) -> true
; Term0 = Term ; Term0 = Term
), ),
( '$get_b_value'(B), write(' '), call(Term), '$write_eqs_and_read_input'(B, VarList), ( '$get_b_value'(B), write(' '), call(Term), write_eqs_and_read_input(B, VarList),
! !
% clear attribute goal lists, which may be populated by % clear attribute goal lists, which may be populated by
% copy_term/3 prior to failure. % copy_term/3 prior to failure.
; '$clear_attribute_goals', write('false.'), nl ; '$clear_attribute_goals', write('false.'), nl
). ).
'$needs_bracketing'(Value, Op) :- needs_bracketing(Value, Op) :-
catch((functor(Value, F, _), catch((functor(Value, F, _),
current_op(EqPrec, EqSpec, Op), current_op(EqPrec, EqSpec, Op),
current_op(FPrec, _, F)), current_op(FPrec, _, F)),
@@ -65,16 +65,16 @@
false), false),
( EqPrec < FPrec -> true ( EqPrec < FPrec -> true
; '$quoted_token'(F) -> true ; '$quoted_token'(F) -> true
; atom_length(F, 1), '$graphic_token_char'(F) -> true ; atom_length(F, 1), graphic_token_char(F) -> true
; EqPrec == FPrec, ; EqPrec == FPrec,
memberchk(EqSpec, [fx,xfx,yfx]) memberchk(EqSpec, [fx,xfx,yfx])
). ).
'$write_goal'(G, VarList, MaxDepth) :- write_goal(G, VarList, MaxDepth) :-
( G = (Var = Value) -> ( G = (Var = Value) ->
write(Var), write(Var),
write(' = '), write(' = '),
( '$needs_bracketing'(Value, (=)) -> ( needs_bracketing(Value, (=)) ->
write('('), write('('),
write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]), write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
write(')') write(')')
@@ -85,16 +85,16 @@
; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]) ; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
). ).
'$write_last_goal'(G, VarList, MaxDepth) :- write_last_goal(G, VarList, MaxDepth) :-
( G = (Var = Value) -> ( G = (Var = Value) ->
write(Var), write(Var),
write(' = '), write(' = '),
( '$needs_bracketing'(Value, (=)) -> ( needs_bracketing(Value, (=)) ->
write('('), write('('),
write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]), write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
write(')') write(')')
; write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]), ; write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
( '$trailing_period_is_ambiguous'(Value) -> ( trailing_period_is_ambiguous(Value) ->
write(' ') write(' ')
; true ; true
) )
@@ -104,70 +104,70 @@
; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]) ; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
). ).
'$write_eq'((G1, G2), VarList, MaxDepth) :- write_eq((G1, G2), VarList, MaxDepth) :-
!, !,
'$write_goal'(G1, VarList, MaxDepth), write_goal(G1, VarList, MaxDepth),
write(', '), write(', '),
'$write_eq'(G2, VarList, MaxDepth). write_eq(G2, VarList, MaxDepth).
'$write_eq'(G, VarList, MaxDepth) :- write_eq(G, VarList, MaxDepth) :-
'$write_last_goal'(G, VarList, MaxDepth). write_last_goal(G, VarList, MaxDepth).
'$graphic_token_char'(C) :- graphic_token_char(C) :-
memberchk(C, ['#', '$', '&', '*', '+', '-', '.', ('/'), ':', memberchk(C, ['#', '$', '&', '*', '+', '-', '.', ('/'), ':',
'<', '=', '>', '?', '@', '^', '~', ('\\')]). '<', '=', '>', '?', '@', '^', '~', ('\\')]).
'$list_last_item'([C], C) :- !. list_last_item([C], C) :- !.
'$list_last_item'([_|Cs], D) :- list_last_item([_|Cs], D) :-
'$list_last_item'(Cs, D). list_last_item(Cs, D).
'$trailing_period_is_ambiguous'(Value) :- trailing_period_is_ambiguous(Value) :-
atom(Value), atom(Value),
atom_chars(Value, ValueChars), atom_chars(Value, ValueChars),
'$list_last_item'(ValueChars, Char), list_last_item(ValueChars, Char),
ValueChars \== ['.'], ValueChars \== ['.'],
'$graphic_token_char'(Char). graphic_token_char(Char).
'$write_eqs_and_read_input'(B, VarList) :- write_eqs_and_read_input(B, VarList) :-
charsio:extend_var_list(VarList, VarList, NewVarList, fabricated), charsio:extend_var_list(VarList, VarList, NewVarList, fabricated),
sort(NewVarList, SortedVarList), sort(NewVarList, SortedVarList),
'$get_b_value'(B0), '$get_b_value'(B0),
'$gather_goals'(SortedVarList, SortedVarList, Goals), gather_goals(SortedVarList, SortedVarList, Goals),
( B0 == B -> ( B0 == B ->
( Goals == [] -> ( Goals == [] ->
write('true.'), nl write('true.'), nl
; thread_goals(Goals, ThreadedGoals, (',')), ; thread_goals(Goals, ThreadedGoals, (',')),
'$write_eq'(ThreadedGoals, NewVarList, 20), write_eq(ThreadedGoals, NewVarList, 20),
write('.'), write('.'),
nl nl
) )
; thread_goals(Goals, ThreadedGoals, (',')), ; thread_goals(Goals, ThreadedGoals, (',')),
'$write_eq'(ThreadedGoals, NewVarList, 20), write_eq(ThreadedGoals, NewVarList, 20),
'$read_input'(ThreadedGoals, NewVarList) read_input(ThreadedGoals, NewVarList)
). ).
'$read_input'(ThreadedGoals, NewVarList) :- read_input(ThreadedGoals, NewVarList) :-
get_single_char(C), get_single_char(C),
( C = w -> ( C = w ->
nl, nl,
write(' '), write(' '),
'$write_eq'(ThreadedGoals, NewVarList, 0), write_eq(ThreadedGoals, NewVarList, 0),
'$read_input'(ThreadedGoals, NewVarList) read_input(ThreadedGoals, NewVarList)
; C = p -> ; C = p ->
nl, nl,
write(' '), write(' '),
'$write_eq'(ThreadedGoals, NewVarList, 20), write_eq(ThreadedGoals, NewVarList, 20),
'$read_input'(ThreadedGoals, NewVarList) read_input(ThreadedGoals, NewVarList)
; member(C, [';', ' ', n]) -> ; member(C, [';', ' ', n]) ->
nl, write('; '), false nl, write('; '), false
; C = h -> ; C = h ->
'$help_message', help_message,
'$read_input'(ThreadedGoals, NewVarList) read_input(ThreadedGoals, NewVarList)
; member(C, ['\n', .]) -> ; member(C, ['\n', .]) ->
nl, write('; ...'), nl nl, write('; ...'), nl
; '$read_input'(ThreadedGoals, NewVarList) ; read_input(ThreadedGoals, NewVarList)
). ).
'$help_message' :- help_message :-
nl, nl, nl, nl,
write('SPACE, "n" or ";": next solution, if any\n'), write('SPACE, "n" or ";": next solution, if any\n'),
write('RETURN or ".": stop enumeration\n'), write('RETURN or ".": stop enumeration\n'),
@@ -175,44 +175,44 @@
write('"w": write terms without depth limit\n'), write('"w": write terms without depth limit\n'),
write('"p": print terms with depth limit\n\n'). write('"p": print terms with depth limit\n\n').
'$gather_query_vars'([_ = Var | Vars], QueryVars) :- gather_query_vars([_ = Var | Vars], QueryVars) :-
( var(Var) -> ( var(Var) ->
QueryVars = [Var | QueryVars1], QueryVars = [Var | QueryVars1],
'$gather_query_vars'(Vars, QueryVars1) gather_query_vars(Vars, QueryVars1)
; '$gather_query_vars'(Vars, QueryVars) ; gather_query_vars(Vars, QueryVars)
). ).
'$gather_query_vars'([], []). gather_query_vars([], []).
'$is_a_different_variable'([_ = Binding | Pairs], Value) :- is_a_different_variable([_ = Binding | Pairs], Value) :-
( Value == Binding, ! ( Value == Binding, !
; '$is_a_different_variable'(Pairs, Value) ; is_a_different_variable(Pairs, Value)
). ).
'$gather_goals'([], VarList, Goals) :- gather_goals([], VarList, Goals) :-
'$gather_query_vars'(VarList, QueryVars), gather_query_vars(VarList, QueryVars),
copy_term(QueryVars, QueryVars, Goals). copy_term(QueryVars, QueryVars, Goals).
'$gather_goals'([Var = Value | Pairs], VarList, Goals) :- gather_goals([Var = Value | Pairs], VarList, Goals) :-
( ( nonvar(Value) ( ( nonvar(Value)
; '$is_a_different_variable'(Pairs, Value) ; is_a_different_variable(Pairs, Value)
) -> ) ->
Goals = [Var = Value | Goals0], Goals = [Var = Value | Goals0],
'$gather_goals'(Pairs, VarList, Goals0) gather_goals(Pairs, VarList, Goals0)
; '$gather_goals'(Pairs, VarList, Goals) ; gather_goals(Pairs, VarList, Goals)
). ).
'$print_exception'(E) :- print_exception(E) :-
write_term('caught: ', [quoted(false), max_depth(20)]), write_term('caught: ', [quoted(false), max_depth(20)]),
writeq(E), writeq(E),
nl. nl.
'$print_exception_with_check'(E) :- print_exception_with_check(E) :-
( E = error(_, _:_) -> true % if the error source contains a line ( E = error(_, _:_) -> true % if the error source contains a line
% number, a GNU-style error message % number, a GNU-style error message
% is expected to be printed instead. % is expected to be printed instead.
; '$print_exception'(E) ; print_exception(E)
). ).
'$module_export'(Source, PI) :- module_export(Source, PI) :-
( nonvar(PI) -> ( nonvar(PI) ->
( PI = Name / Arity -> ( PI = Name / Arity ->
( var(Name) -> throw(error(instantiation_error, Source)) ( var(Name) -> throw(error(instantiation_error, Source))
@@ -278,7 +278,7 @@ user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :-
expand_goals(Goals, ExpandedGoals), expand_goals(Goals, ExpandedGoals),
Goals \== ExpandedGoals. Goals \== ExpandedGoals.
'$module_expand_goal'(UnexpandedGoals, ExpandedGoals) :- module_expand_goal(UnexpandedGoals, ExpandedGoals) :-
( '$module_of'(Module, UnexpandedGoals), ( '$module_of'(Module, UnexpandedGoals),
'$module_exists'(Module), '$module_exists'(Module),
Module:goal_expansion(UnexpandedGoals, ExpandedGoals), Module:goal_expansion(UnexpandedGoals, ExpandedGoals),
@@ -290,7 +290,7 @@ user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :-
expand_goals(UnexpandedGoals, ExpandedGoals) :- expand_goals(UnexpandedGoals, ExpandedGoals) :-
nonvar(UnexpandedGoals), nonvar(UnexpandedGoals),
var(ExpandedGoals), var(ExpandedGoals),
( '$module_expand_goal'(UnexpandedGoals, Goals) -> ( module_expand_goal(UnexpandedGoals, Goals) ->
true true
; Goals = UnexpandedGoals ; Goals = UnexpandedGoals
), ),