refactorisation

parent 9f1b85c7
......@@ -116,7 +116,14 @@ PSSOURCES = \
logic/guile-log/guile-prolog/gc-call.scm \
logic/guile-log/guile-prolog/coroutine.scm \
logic/guile-log/guile-prolog/attributator.scm \
logic/guile-log/guile-prolog/optimize.scm \
logic/guile-log/guile-prolog/vm-pre.scm \
logic/guile-log/guile-prolog/vm-scm.scm \
logic/guile-log/guile-prolog/vm-args.scm \
logic/guile-log/guile-prolog/vm-handle.scm \
logic/guile-log/guile-prolog/vm-imprint.scm \
logic/guile-log/guile-prolog/vm-unify.scm \
logic/guile-log/guile-prolog/vm-goal.scm \
logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \
prolog-user.scm
......
This diff is collapsed.
(define-module (logic guile-log guile-prolog vm-args)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (logic guile-log guile-prolog vm-pre)
#:use-module (compat racket misc)
#:use-module (system vm assembler)
#:export (caller push_args_args2 push_args_args push_args))
(compile-prolog-string "
narg(X,N,N) :- var(X),!.
narg([X|L],I,N) :-
II is I + 1,
narg(L,II,N).
narg(_,I,I).
push_args_args(X,V,L,LL) :- var(X),!,
push_args(X,V,L,LL).
push_args_args([X|Y],V,L,LL) :- !,
link_v(V,V1,V2),
push_args(X,V1,L,L1),
push_args_args(Y,V2,L1,LL).
push_args_args([],V,L,L) :- !,equal_v(V).
push_args_args2(X,V,L,LL) :- var(X),!,
push_args(X,V,L,LL).
push_args_args2([X|Y],V,L,LL) :- !,
link_v(V,V1,V2),
push_args(X,V1,L,L1),
push_args_args2(Y,V2,L1,LL).
push_args_args2([],V,L,LL) :-
push_args([],V,L,LL).
push_args(X,V,L,LL) :- var(X),!,
add_var(X,V,Tag),
push_v(1,V),
tr('push-variable',Push),
L=[[Push,Tag]|LL].
push_args([X|Y],V,L,LL) :- !,
tr('mk-cons',Cons),
link_v(V,V1,V2,V3),
push_args(X,V1,L,L1),
push_args(Y,V2,L1,L2),
push_vv(-1,V3),
L2=[[Cons]|LL].
push_args(X(|Y),V,L,LL) :- !,
tr('mk-fkn',Fkn),
link_v(V,V1,V2),
narg(Y,0,NN),N is NN + 1,
push_args_args2([X|Y],V1,L,L1),
M is -N, push_vv(M,V2),
L1=[[Fkn,N]|LL].
push_args({X},V,L,LL) :- !,
tr('mk-curly',MK),
push_args(X,V,L,L1),
L1=[[MK]|LL].
push_args(X,V,L,LL) :-
push_vv(1,V),
(
constant(X) ->
(tr('push-constant',Push),regconst(X,XX),L=[[Push,XX]|LL]) ;
(tr('push-instruction',Push),L=[[Push,X]|LL])
).
caller(F,Args,Tail,[C,E,M,[S,S],B,H],[L,LL]) :-
(Tail == #t -> tr('tail-call', Call) ; tr(call,Call)),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
link_v([C,E,M,[0,_],B,H],V1,V2,V3),
push_args(F,V1,L2,L3),
push_vv(3,V2),
tr(seek,Seek),
L3=[[Seek,3]|L4],
push_args_args(Args,V3,L4,LL2),
LL2 = [[Call]|LL].
")
(compile-prolog-string
"
narg(X,N,N) :- var(X),!.
narg([X|L],I,N) :-
II is I + 1,
narg(L,II,N).
narg(_,I,I).
push_args_args(X,V,L,LL) :- var(X),!,
push_args(X,V,L,LL).
push_args_args([X|Y],V,L,LL) :- !,
link_v(V,V1,V2),
push_args(X,V1,L,L1),
push_args_args(Y,V2,L1,LL).
push_args_args([],V,L,L) :- !,equal_v(V).
push_args_args2(X,V,L,LL) :- var(X),!,
push_args(X,V,L,LL).
push_args_args2([X|Y],V,L,LL) :- !,
link_v(V,V1,V2),
push_args(X,V1,L,L1),
push_args_args2(Y,V2,L1,LL).
push_args_args2([],V,L,LL) :-
push_args([],V,L,LL).
push_args(X,V,L,LL) :- var(X),!,
add_var(X,V,Tag),
push_v(1,V),
tr('push-variable',Push),
L=[[Push,Tag]|LL].
push_args([X|Y],V,L,LL) :- !,
tr('mk-cons',Cons),
link_v(V,V1,V2,V3),
push_args(X,V1,L,L1),
push_args(Y,V2,L1,L2),
push_vv(-1,V3),
L2=[[Cons]|LL].
push_args(X(|Y),V,L,LL) :- !,
tr('mk-fkn',Fkn),
link_v(V,V1,V2),
narg(Y,0,NN),N is NN + 1,
push_args_args2([X|Y],V1,L,L1),
M is -N, push_vv(M,V2),
L1=[[Fkn,N]|LL].
push_args({X},V,L,LL) :- !,
tr('mk-curly',MK),
push_args(X,V,L,L1),
L1=[[MK]|LL].
push_args(X,V,L,LL) :-
push_vv(1,V),
(
constant(X) ->
(tr('push-constant',Push),regconst(X,XX),L=[[Push,XX]|LL]) ;
(tr('push-instruction',Push),L=[[Push,X]|LL])
).
caller(F,Args,Tail,[C,E,M,[S,S],B,H],[L,LL]) :-
(Tail == #t -> tr('tail-call', Call) ; tr(call,Call)),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
link_v([C,E,M,[0,_],B,H],V1,V2,V3),
push_args(F,V1,L2,L3),
push_vv(3,V2),
tr(seek,Seek),
L3=[[Seek,3]|L4],
push_args_args(Args,V3,L4,LL2),
LL2 = [[Call]|LL].
")
(define-module (logic guile-log guile-prolog vm-compiler)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (logic guile-log vlist)
#:use-module (logic guile-log guile-prolog vm-pre)
#:use-module (logic guile-log guile-prolog vm-goal)
#:use-module (system vm assembler)
#:export (compilable_scm collect_data compile_goal pretty instr
make-vm-function
imprint compile_to_fkn
begin_att end_att))
#|
The question is if we can design a system for prolog programs
f -> X=1,f. => this system works quite nicely
f -> X=1,f,X=2 => the second f needs to be a new function
A=[V3,V2,V1]
F1->X,F2,V,X
A=[V4,V3,V2,V1]
F2->X,F3,V,X
In tail call context we will create variale set records, that can garabage
collect, now the A vector will grow but that's fine, this means that the cc
code needs a field to check the A link and restore the stack in that case
for this we need the V3 identity which is carried over as a closure variable
(A,Code,Constants) can be imbeded in the actual function
(let ((A,Code,Constant))
(lambda () (ins A Code Constant)))
The cc object has cc=(V,i,f)
The p object has p =(P,i,f)
This is quite effective in that if
If we store a state then all function frames that are active will need
to be freezed. What we can do is to simply link frames in the stack and
traverse them backwards at state storage. This means that when we set a
a variable we simply check if the frame is looked or not. One option is
then to set all variables at function creation. But the first version
will be a create all at startup variant for now.
|#
#|
TODO:
1. Trace failure thunk, so that we know if we can remove a variable, DONE
2. Cut, DONE
3. true
4. false/fail
5. Expression evaluator.
6. Creation of variables will be done if not already present
7. Implement all the unification idioms
8. Add attribute logic to the unification
9. Add a clause compiler
10. Add a clauses compiler
11. Debug or, also make sure that -> and \+ works as it should
12. Add macro logic, not numbers in op's.
13. handle negative unary operator
What about storing the control stack in a linked assoc
newfram: link on, id
unwind: link of, id
plus, link on, id
sucess, link off, id
onece
link on id
link off id
We also want to transfer the cut between frames, unwinds have a cut in them
via the instruction this means that we need to store both the failure thunk
as well as the cc when we enter a function.
Another optimization is to check at cc if failure in is failure out. if so
we now that we can change the p thunk to the actual memory location and skip
a rounderm to the guile vm, this will speed upp execution quite alot.
what need to be stored per session:
p,cc variables
what need to be transfered at a call:
ctrl-stack, stack, next-instruction, narg
what is constant
instructions,constants,dimensions,nvar
( #(narg ctrl-stack stack)
variables
.
(nvar instructions constants))
variables is the most difficult part to maintain
|#
(define vm-bytevector
(let ((bv (make-u32vector 1 0)))
(u32vector-set! bv 0 175)
bv))
;; Setting up the vm engine meta information
(define vm-model
((@@ (logic guile-log code-load) gp-make-vm-model) vm-bytevector))
((@@ (logic guile-log code-load) gp-setup-prolog-vm-env)
(@@ (logic guile-log macros ) dls)
(@@ (logic guile-log code-load) *delayers*)
(@@ (logic guile-log umatch ) *unwind-hooks*)
(@@ (logic guile-log umatch ) *unwind-parameters*)
(lambda x #t)
(lambda () #f)
(@@ (logic guile-log macros ) gp-not-n)
(@@ (logic guile-log macros ) gp-is-delayed?)
vm-model)
(define (make-vm-function nlocals code tvar constants)
((@@ (logic guile-log code-load) gp-custom-fkn)
vm-model 1 '()
(cons #f (cons code (cons constants tvar)))
nlocals))
(define (list->vector l)
(let ((v (make-vector ((@ (guile) length) l) #f)))
(let lp ((l l) (i 0))
(if (pair? l)
(begin
(vector-set! v i (car l))
(lp (cdr l) (+ i 1)))))
v))
(define (mk-instructions nvars l)
(let ((v (make-vector (+ 1 ((@ (guile) length) l)) #f)))
(vector-set! v 0 nvars)
(let lp ((l l) (i 1))
(if (pair? l)
(begin
(vector-set! v i (car l))
(lp (cdr l) (+ i 1)))))
v))
(define (name-it x) (set-procedure-property! x 'name 'anonymous) x)
(<define> (compile_to_fkn code f)
(<var> (stackSize constants l nvar tvar narg)
(compile_goal code l stackSize narg constants #f)
(get_varn nvar)
(get_vart tvar)
(<recur> lp ((l (<scm> l)) (o '()))
(<<match>> (#:mode -) (l)
((x . l) (lp l ((@ (guile) append) ((@ (guile) reverse) x) o)))
(()
(let ((instructions ((@ (guile) reverse) o))
(nvar (<lookup> nvar))
(tvar (<lookup> tvar))
(narg (<lookup> narg))
(stackSize (<lookup> stackSize))
(constants (map car (<scm> constants))))
(<=> f
,(name-it
(make-vm-function (cons stackSize (+ narg 4))
(mk-instructions nvar instructions)
tvar
(list->vector constants))))))))))
(define-module (logic guile-log guile-prolog optimize)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (logic guile-log vlist)
#:use-module (logic guile-log guile-prolog vm-pre)
#:use-module (logic guile-log guile-prolog vm-goal)
#:use-module (system vm assembler)
#:export (compilable_scm collect_data compile_goal pretty instr
make-vm-function
imprint compile_to_fkn
begin_att end_att))
#|
The question is if we can design a system for prolog programs
f -> X=1,f. => this system works quite nicely
f -> X=1,f,X=2 => the second f needs to be a new function
A=[V3,V2,V1]
F1->X,F2,V,X
A=[V4,V3,V2,V1]
F2->X,F3,V,X
In tail call context we will create variale set records, that can garabage
collect, now the A vector will grow but that's fine, this means that the cc
code needs a field to check the A link and restore the stack in that case
for this we need the V3 identity which is carried over as a closure variable
(A,Code,Constants) can be imbeded in the actual function
(let ((A,Code,Constant))
(lambda () (ins A Code Constant)))
The cc object has cc=(V,i,f)
The p object has p =(P,i,f)
This is quite effective in that if
If we store a state then all function frames that are active will need
to be freezed. What we can do is to simply link frames in the stack and
traverse them backwards at state storage. This means that when we set a
a variable we simply check if the frame is looked or not. One option is
then to set all variables at function creation. But the first version
will be a create all at startup variant for now.
|#
#|
TODO:
1. Trace failure thunk, so that we know if we can remove a variable, DONE
2. Cut, DONE
3. true
4. false/fail
5. Expression evaluator.
6. Creation of variables will be done if not already present
7. Implement all the unification idioms
8. Add attribute logic to the unification
9. Add a clause compiler
10. Add a clauses compiler
11. Debug or, also make sure that -> and \+ works as it should
12. Add macro logic, not numbers in op's.
13. handle negative unary operator
What about storing the control stack in a linked assoc
newfram: link on, id
unwind: link of, id
plus, link on, id
sucess, link off, id
onece
link on id
link off id
We also want to transfer the cut between frames, unwinds have a cut in them
via the instruction this means that we need to store both the failure thunk
as well as the cc when we enter a function.
Another optimization is to check at cc if failure in is failure out. if so
we now that we can change the p thunk to the actual memory location and skip
a rounderm to the guile vm, this will speed upp execution quite alot.
what need to be stored per session:
p,cc variables
what need to be transfered at a call:
ctrl-stack, stack, next-instruction, narg
what is constant
instructions,constants,dimensions,nvar
( #(narg ctrl-stack stack)
variables
.
(nvar instructions constants))
variables is the most difficult part to maintain
|#
(define vm-bytevector
(let ((bv (make-u32vector 1 0)))
(u32vector-set! bv 0 175)
bv))
;; Setting up the vm engine meta information
(define vm-model
((@@ (logic guile-log code-load) gp-make-vm-model) vm-bytevector))
((@@ (logic guile-log code-load) gp-setup-prolog-vm-env)
(@@ (logic guile-log macros ) dls)
(@@ (logic guile-log code-load) *delayers*)
(@@ (logic guile-log umatch ) *unwind-hooks*)
(@@ (logic guile-log umatch ) *unwind-parameters*)
(lambda x #t)
(lambda () #f)
(@@ (logic guile-log macros ) gp-not-n)
(@@ (logic guile-log macros ) gp-is-delayed?)
vm-model)
(define (make-vm-function nlocals code tvar constants)
((@@ (logic guile-log code-load) gp-custom-fkn)
vm-model 1 '()
(cons #f (cons code (cons constants tvar)))
nlocals))
(define (list->vector l)
(let ((v (make-vector ((@ (guile) length) l) #f)))
(let lp ((l l) (i 0))
(if (pair? l)
(begin
(vector-set! v i (car l))
(lp (cdr l) (+ i 1)))))
v))
(define (mk-instructions nvars l)
(let ((v (make-vector (+ 1 ((@ (guile) length) l)) #f)))
(vector-set! v 0 nvars)
(let lp ((l l) (i 1))
(if (pair? l)
(begin
(vector-set! v i (car l))
(lp (cdr l) (+ i 1)))))
v))
(define (name-it x) (set-procedure-property! x 'name 'anonymous) x)
(<define> (compile_to_fkn code f)
(<var> (stackSize constants l nvar tvar narg)
(compile_goal code l stackSize narg constants #f)
(get_varn nvar)
(get_vart tvar)
(<recur> lp ((l (<scm> l)) (o '()))
(<<match>> (#:mode -) (l)
((x . l) (lp l ((@ (guile) append) ((@ (guile) reverse) x) o)))
(()
(let ((instructions ((@ (guile) reverse) o))
(nvar (<lookup> nvar))
(tvar (<lookup> tvar))
(narg (<lookup> narg))
(stackSize (<lookup> stackSize))
(constants (map car (<scm> constants))))
(<=> f
,(name-it
(make-vm-function (cons stackSize (+ narg 4))
(mk-instructions nvar instructions)
tvar
(list->vector constants))))))))))
(define-module (logic guile-log guile-prolog vm-disj)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc)
#:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog vm-pre)
#:export (compile_disj compile_disjunction collect_disjunction))
(compile-prolog-string "
collect_disj([],U,U).
collect_disj([X|L],U,UU) :-
collect_disjunction(X,U,U1),
collect_disj(L,U1,UU).
collect_disjunction(X,[X|UU],UU) :- var(X),!.
collect_disjunction(';'(|L),U,UU) :- !,
collect_disj(L,U,UU).
collect_disjunction(X,[X|UU],UU).
tail(Tail,LL,LLL) :-
Tail = #t ->
(tr(cc,CC),LLL=[[CC]|LL]) ;
LLL=LL.
compile_disjunction
([X],First,Out,Es,Lab,A,Tail,S0,[U],
[[A,AA],[C,CC],[E,EE],[M,MM],[S,SS],[B,BB],H],[L,LL]) :- !,
compile_goal(X,Tail,[[A,A1],[C,C1],[0,E1],[M,MM],[A,S1],[B,BB],H],[LX,LL]),
(A == A1 -> AA=A ; throw(all_disjuction_goals_needs_the_same_begin_level)),
SS is max(S,S1),
EE is E \\/ E1,
U = [E1,_],
tr('unwind-tail',UnwindTail),
L=[[label,Lab,U],[UnwindTail,A,0] | LX].
compile_disjunction([X|Y],First,Out,Es, Lab,A,Tail,S0,[U|UU],V,[L,LL]) :- !,
tr('goto-inst',Goto),
V = [[Aq,AAq],[C,CC],[E,EE],[M,MM],[S,SS],[B,BB],H],
(Tail==#t -> LG=LLX ; LG = [[Goto,Out]|LLX]),
V1 = [[Aq,A1q],[C,C1],[0,E1],[M,M1],[S0,S1],[B,B1],H],
compile_goal(X,Tail,V1,[LX,LG]),
S2 is max(S,S1),
E2 is E \\/ E1,
U = [E1,_],
VV = [[A2q,AAq],[C,CC],[E2,EE],[M1,MM],[S2,SS],[B1,BB],H],
LQ =[LLX,LL],
(First == #t ->
(
A2q=A1q,
L = [[label,_,U]|LX],
compile_disjunction(Y,#f,Out,[U|Es],Lab,A,Tail,S0,UU,VV,LQ)
) ;
(
(
Aq == A1q -> A1q=A2q ;
throw(all_disjuction_goals_needs_the_same_begin_level)
),
label(Lab2),tr(unwind,Unwind),
L = [[label,Lab,U],[unwind,A,Lab2,0]|LX],
compile_disjunction(Y,#f,Out,[U|Es],Lab2,A,Tail,S0,UU,VV,LQ)
)
).
")
(compile-prolog-string "
find_all_tags(H,0 ,[]).
find_all_tags(H,Es,L) :-
H=[HC,HV],
maskoff(Es,E,EEs),
vhashql_ref(HC,E,V),
(
var(V) -> find_all_tags(H,EEs,L) ;
V=[_,_,_] -> (L=[V|LL], find_all_tags(H,EEs,LL));
find_all_tags(H,EEs,L)
).
add_miss(_,[],[],E,E).
add_miss(H,[[X,N,C]|Xs],Ys,E,EE) :-
C==#t ->
(
new_tag(H,X,Tag,Etag),
first(Tag),
E1 is E \\/ Etag,
Ys=[Tag|YYs],
add_miss(H,Xs,YYs,E1,EE)
) ;
add_miss(H,Xs,Ys,E,EE).
add_missing_variables(_,[],E,E).
add_missing_variables(H,[[E,V]|Es],EE,EEE) :-
Ex is EE /\\ \\E,
find_all_tags(H,Ex,Tags),
add_miss(H,Tags,V,EE,EE2),
add_missing_variables(H,Es,EE2,EEE).
collect_disj([],U,U).
collect_disj([X|L],U,UU) :-
collect_disjunction(X,U,U1),
collect_disj(L,U1,UU).
collect_disjunction(X,[X|UU],UU) :- var(X),!.
collect_disjunction(';'(|L),U,UU) :- !,
collect_disj(L,U,UU).
collect_disjunction(X,[X|UU],UU).
tail(Tail,LL,LLL) :-
Tail = #t ->
(tr(cc,CC),LLL=[[CC]|LL]) ;
LLL=LL.
compile_disjunction
([X],First,Out,Es,Lab,A,Tail,S0,[U],
[[A,AA],[C,CC],[E,EE],[M,MM],[S,SS],[B,BB],H],[L,LL]) :- !,
compile_goal(X,Tail,[[A,A1],[C,C1],[0,E1],[M,MM],[A,S1],[B,BB],H],[LX,LL]),
(A == A1 -> AA=A ; throw(all_disjuction_goals_needs_the_same_begin_level)),
SS is max(S,S1),
EE is E \\/ E1,
U = [E1,_],
tr('unwind-tail',UnwindTail),
L=[[label,Lab,U],[UnwindTail,A,0] | LX].
compile_disjunction([X|Y],First,Out,Es, Lab,A,Tail,S0,[U|UU],V,[L,LL]) :- !,
tr('goto-inst',Goto),
V = [[Aq,AAq],[C,CC],[E,EE],[M,MM],[S,SS],[B,BB],H],
(Tail==#t -> LG=LLX ; LG = [[Goto,Out]|LLX]),
V1 = [[Aq,A1q],[C,C1],[0,E1],[M,M1],[S0,S1],[B,B1],H],
compile_goal(X,Tail,V1,[LX,LG]),
S2 is max(S,S1),
E2 is E \\/ E1,
U = [E1,_],
VV = [[A2q,AAq],[C,CC],[E2,EE],[M1,MM],[S2,SS],[B1,BB],H],
LQ =[LLX,LL],
(First == #t ->
(
A2q=A1q,
L = [[label,_,U]|LX],
compile_disjunction(Y,#f,Out,[U|Es],Lab,A,Tail,S0,UU,VV,LQ)
) ;
(
(
Aq == A1q -> A1q=A2q ;
throw(all_disjuction_goals_needs_the_same_begin_level)
),
label(Lab2),tr(unwind,Unwind),
L = [[label,Lab,U],[unwind,A,Lab2,0]|LX],
compile_disjunction(Y,#f,Out,[U|Es],Lab2,A,Tail,S0,UU,VV,LQ)
)
).
mmtr([],[]).
mmtr([[X|Y]|LA],[[XX|Y]|LB]) :-
(tr(X,XX);binop(X,XX);unop(X,XX)),
mmtr(LA,LB).
mg(E,X,_,_,_) :-
var(X) -> throw(predicate_must_have_proper_tail(E)).
mg(E,[],true,N,N).
mg(E,[X],imprint(X,0),I,N) :- !, N is I + 1.
mg(E,[X|L],(imprint(X,0),U),I,N) :-
II is I + 1,
mg(E,L,U,II,N).
listp(X) :- var(X) -> (!, fail).
listp([X|Y]) :- listp(Y).
listp([]).
")
(define-module (logic guile-log guile-prolog vm-goal)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc)
#:use-module (logic guile-log guile-prolog vm-args)
#:use-module (logic guile-log guile-prolog vm-unify)
#:use-module (logic guile-log guile-prolog vm-imprint)
#:use-module (logic guile-log guile-prolog vm-scm)
#:use-module (logic guile-log guile-prolog vm-disj)
#:use-module (logic guile-log guile-prolog vm-pre)
#:use-module (logic guile-log guile-prolog vm-handle)
#:use-module (system vm assembler)
#:re-export (compile_goal))
(compile-prolog-string "
reverse_op(<,>).
reverse_op(>,<).
reverse_op(=<,>=).
reverse_op(>=,=<).
reverse_op(@<,@>).
reverse_op(@>,@<).
reverse_op(@=<,@>=).
reverse_op(@>=,@=<).
reverse_op(=:=,=:=).
reverse_op(=\\=,=\\=).
touch_A([[[[_,_,#t]|_],_] |_]).
-extended(',',m_and,;,m_or,\\+,m_not).
compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
(
Code = (F(|A) :- Goal) -> length(A,Narg) ;
Code = (F :- Goal) -> Narg = 0 ;