1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
:- module(repl, []).
repl([ProgName|Args]) :-
write('Welcome to p-prolog version 1'),
nl,
write('Started with args: '),
write(Args),
nl,
handle_args(Args),
repl_loop.
handle_arg('-d') :-
set_prolog_flag(debug, on).
handle_arg(Arg) :-
write('Unhandled command line argument: '),
writeq(Arg),
nl.
handle_args([Arg|Rest]) :- handle_arg(Arg), !, handle_args(Rest).
handle_args([]).
repl_loop :-
catch(read_eval_print, E, print_exception(E)),
'$collect_garbage',
repl_loop.
read_eval_print :-
write('?- '),
asserta(found_a_solution :- (!, fail)),
read_term(Term, [variable_names(Vars)]),
'$choicestack_size'(Choicecount),
eval_and_print(Term, Vars, Choicecount),
!,
abolish(found_a_solution/0).
eval_and_print(Goal, Vars, Choicecount) :-
user:call(Goal),
abolish(found_a_solution/0),
asserta(found_a_solution :- !),
'$choicestack_size'(ChoicecountNew),
( ChoicecountNew > Choicecount + 1
-> write_result(Vars, more),
get_raw_char(Char),
( Char = ';'
-> put_char(Char),
nl,
'$collect_garbage',
asserta(found_a_solution :- (!, fail)),
fail % backtrack and call G again
; put_char('.'), nl
)
; write_result(Vars, end)
).
eval_and_print(Goal, _, _) :-
\+ found_a_solution,
write('false.'),
nl.
write_state(end) :- write('.'), nl.
write_state(more).
write_result([], State) :- write('true'), write_state(State).
write_result([B|Bs], State) :- write_bindings([B|Bs]), write_state(State).
write_bindings([]).
write_bindings([Var = Val|Bs]) :-
write(Var),
write(' = '),
writeq(Val),
( Bs = []
-> true
; put_char(','), nl
),
write_bindings(Bs).
print_exception(E) :-
write('Unhandled exception: '),
write(E),
nl.
whitespace(' ').
whitespace(' ').
whitespace('
').
get_raw_char(Char) :-
open('/dev/consctl', write, S),
write(S, rawon),
get_one_char(Char),
write(S, rawoff),
close(S).
get_one_char(Char) :-
get_char(C),
( whitespace(C)
-> get_one_char(Char)
; Char = C
).
|