[Shell. gergo@complang.tuwien.ac.at**20090127145135] { merger 0.0 ( hunk ./compiler.fs 762 +256 constant max-line +Create line-buffer max-line allot +: shell + begin + while line-buffer max-line stdin read-line throw { flag } + line-buffer swap 2dup type cr + dup 0 > if + compile + eval + endif + flag + repeat +; + hunk ./compiler.fs 762 +create clause-input-buf 256 chars allot + +: clauses ( -- ) + cr ." Enter clauses, one per line; empty line when you're done." cr + begin + ." > " + clause-input-buf 256 accept + ( input-len ) + dup 0<> while + clause-input-buf swap + compile + eval + repeat + drop + ; + +: queries ( -- ) + interactive-mode on + cr ." Enter queries, one per line; empty line when you're done." cr + begin + ." ?- " + clause-input-buf 256 accept + ( input-len ) + dup 0<> while + clause-input-buf swap + compile-query + eval + repeat + drop + interactive-mode off + ; + ) merger 0.0 ( hunk ./compiler.fs 786 -s" qsort([],R,R)." compile -s" qsort([X|L],R0,R) :- split(L,X,L1,L2), qsort(L1,R0,[X|R1]), qsort(L2,R1,R)." compile bye +s" qsort([],R,R)." compile eval +s" qsort([X|L],R0,R) :- split(L,X,L1,L2), qsort(L1,R0,[X|R1]), qsort(L2,R1,R)." compile eval hunk ./compiler.fs 787 -s" qsort([X|L],R0,R) :- split(L,X,L1,L2), qsort(L1,R0,[X|R1]), qsort(L2,R1,R)." compile bye +s" qsort([X|L],R0,R) :- split(L,X,L1,L2), qsort(L1,R0,[X|R1]), qsort(L2,R1,R)." compile ) merger 0.0 ( hunk ./compiler.fs 793 -s" :- compare_terms(Y,a,b)." compile eval bye +s" :- compare_terms(Y,a,b)." compile eval + +\ shell + + +s" member(X,[X|_])." compile eval +s" member(X,[_|L]) :- member(X,L)." compile eval +s" :- member(X,[a,b,c])." compile eval + +bye merger 0.0 ( hunk ./compiler.fs 789 -s" :- qsort([a], [], R)." compile eval bye +s" :- qsort([a], [], R)." compile eval merger 0.0 ( hunk ./compiler.fs 789 +s" :- qsort([a], [], R)." compile eval bye +s" :- qsort([], [a,b,c], R)." compile eval +s" :- qsort([a,b,c], [], R)." compile eval +s" :- qsort([b,a,c], [], R)." compile eval hunk ./compiler.fs 789 -s" :- compare_terms(Y,a,b)." compile eval bye +s" :- compare_terms(Y,a,b)." compile eval ) ) ) hunk ./wam.fs 245 +\ Some flags... +create interactive-mode 0 , +create stop-search 0 , + +\ Some flag manipulation words... +: on ( ptr -- ) + -1 swap ! + ; +: off ( ptr -- ) + 0 swap ! + ; +: set? ( ptr -- ) + @ + ; + hunk ./wam.fs 649 + + \ If this is in interactive mode, and the user doesn't want any more + \ solutions, don't print any. + interactive-mode set? stop-search set? and if + drop + exit + endif + hunk ./wam.fs 674 -wam-instr: pl-call ( addr u -- ) - evaluate ( xt ) +wam-instr: pl-call-xt ( xt -- ) + \ If this is in interactive mode, and the user doesn't want any more + \ solutions, don't print any. + interactive-mode set? stop-search set? and if + drop + exit + endif + hunk ./wam.fs 690 - ;binary-wam-instr + ;unary-wam-instr hunk ./wam.fs 692 +wam-instr: pl-call ( addr u -- ) + evaluate ( xt ) + pl-call-xt + ;binary-wam-instr + hunk ./wam.fs 711 - global-state cp-bp @ pl-call + global-state cp-bp @ pl-call-xt hunk ./wam.fs 795 + + \ If this is in interactive mode, and the user doesn't want any more + \ solutions, don't print any. + interactive-mode set? stop-search set? and if exit endif + hunk ./wam.fs 802 - \ TODO: Ask whether to search for additional solutions! - \ ." trying alternatives after solution" cr - global-state cp-bp @ { alternative } - \ ." alternative is: " alternative . cr - \ ." fail is: " fail . cr - alternative ['] pl-fail <> if - ." ;" cr - pop-choice-point - alternative pl-execute-xt + + \ See if mor solutions are wanted. + interactive-mode set? if + key [char] ; = if + 1 + else + stop-search on + 0 + endif + else + 1 + endif + + ( continue-flag ) if + \ ." trying alternatives after solution" cr + global-state cp-bp @ { alternative } + \ ." alternative is: " alternative . cr + \ ." fail is: " fail . cr + alternative ['] pl-fail <> if + ." ;" cr + pop-choice-point + alternative pl-execute-xt + endif hunk ./wam.fs 1386 + stop-search off }