all utility code for vm compiler compiles by the vm compiler

parent d985199e
...@@ -12,11 +12,17 @@ ...@@ -12,11 +12,17 @@
(<define> (extended . l) (<define> (extended . l)
(<code> (error "extended is no good function"))) (<code> (error "extended is no good function")))
(define *extended* #f) (set-procedure-property! extended 'dynamic-directive #t)
(define *extended* #f)
(define *extended-body* #f)
(<define> (set_extended L B) (<define> (set_extended L B)
(<pp> `(set_extended ,L ,B)) (<code> (set! *extended*
(<code> (set! *extended* (<scm> L))) (let lp ((l (<scm> L)) (r '()))
(if (pair? l)
(lp (cddr l) (cons (list (car l) (cadr l)) r))
r))))
(<code> (set! *extended-body* (<scm> B)))) (<code> (set! *extended-body* (<scm> B))))
......
...@@ -24,11 +24,11 @@ narg([X|L],I,N) :- ...@@ -24,11 +24,11 @@ narg([X|L],I,N) :-
narg(_,I,I). narg(_,I,I).
push_code_with_cut(X,Label,V,L,LL) :- push_code_with_cut(X,Label,V,L,LL) :-
L=[[label,Label],[clean-sp]|LX], L=[[label,Label],['clean-sp']|LX],
compile_goal(X,#t,V,[LX,LL]). compile_goal(X,#t,V,[LX,LL]).
push_code_without_cut(X,Label,V,L,LL) :- push_code_without_cut(X,Label,V,L,LL) :-
L=[[label,Label],[clean-sp]|LX], L=[[label,Label],['clean-sp']|LX],
compile_goal(call(X),#t,V,[LX,LL]). compile_goal(call(X),#t,V,[LX,LL]).
push_args_args(K,X,V,L,LL,_,_) :- var_p(X),!,K==#f, push_args_args(K,X,V,L,LL,_,_) :- var_p(X),!,K==#f,
......
...@@ -9,7 +9,8 @@ ...@@ -9,7 +9,8 @@
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog macros) #:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:export (caller push_args_args2 push_args_args push_args)) #:export (caller push_args_args2 push_args_args push_args))
#; #;
......
...@@ -7,7 +7,8 @@ ...@@ -7,7 +7,8 @@
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog macros) #:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var2) #:use-module (logic guile-log guile-prolog vm vm-var2)
#:export (compile_conj collect_conj)) #:export (compile_conj collect_conj))
......
...@@ -7,7 +7,9 @@ ...@@ -7,7 +7,9 @@
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:use-module (logic guile-log soft-cut) #:use-module (logic guile-log soft-cut)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module (logic guile-log guile-prolog macros)
#:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var2) #:use-module (logic guile-log guile-prolog vm vm-var2)
#:export (compile_disj compile_disjunction collect_disj)) #:export (compile_disj compile_disjunction collect_disj))
......
(<define> (set_extended x) (<define> (set_extended x)
(<code> (set! unify_operators (combine_ops (<scm> x))))) (<code> (set! unify_operators (combine_ops (<scm> x)))))
(<define> (gen x) (<=> x ,(gensym "disj")))
(<define> (gen-rec x) (<=> x ,(gensym "Rec")))
(<define> (get_consts x) (<=> x ,(get-consts)))
(compile-prolog-string " (compile-prolog-string "
reverse_op(<,>). reverse_op(<,>).
reverse_op(>,<). reverse_op(>,<).
reverse_op(=<,>=). reverse_op(=<,>=).
...@@ -13,6 +19,8 @@ reverse_op(@>=,@=<). ...@@ -13,6 +19,8 @@ reverse_op(@>=,@=<).
reverse_op(=:=,=:=). reverse_op(=:=,=:=).
reverse_op(=\\=,=\\=). reverse_op(=\\=,=\\=).
zero(V) :- get_A(V,A),A=[[0|_]]. zero(V) :- get_A(V,A),A=[[0|_]].
print([]). print([]).
...@@ -30,7 +38,7 @@ wrap(Code,[L,LL]) :- ...@@ -30,7 +38,7 @@ wrap(Code,[L,LL]) :-
)). )).
-extended(',',m_and,;,m_or,\\+,m_not). -extended(',',m_and,;,m_or,\\+,m_not).
compile_goal(Code,Iout):- compile_goal(Code,Iout):- !,
compile_goal(Code,Iout,StackSize,Narg,Consts,#t). compile_goal(Code,Iout,StackSize,Narg,Consts,#t).
compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !, compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
...@@ -49,7 +57,8 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !, ...@@ -49,7 +57,8 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
%print(L),nl,!, %print(L),nl,!,
get_M(V,StackSize), get_M(V,StackSize),
handle_all(L,LL), handle_all(L,LL),
(var(Constants)->Constants=scm[(get-consts)];true),
(var(Constants)-> get_consts(Constants);true),
%print(LL),nl,!, %print(LL),nl,!,
(Pretty==#t -> Iout=LL ; (b_setval(pretty,#f),mmtr(LL,Iout))). (Pretty==#t -> Iout=LL ; (b_setval(pretty,#f),mmtr(LL,Iout))).
...@@ -153,7 +162,7 @@ compile_goal((F :- Goal),Tail,V,L) :- !, ...@@ -153,7 +162,7 @@ compile_goal((F :- Goal),Tail,V,L) :- !,
wrap(compile_goal((pop(4),Goal),Tail,V,L),L). wrap(compile_goal((pop(4),Goal),Tail,V,L),L).
compile_goal(newtag_F(F),Tail,V,[L,L]) :- compile_goal(newtag_F(F),Tail,V,[L,L]) :-
F=scm[(gensym \"disj\")]. gen(F).
compile_goal(extended_off,Tail,V,[L,L]) :- !, compile_goal(extended_off,Tail,V,[L,L]) :- !,
set_extended(#f). set_extended(#f).
...@@ -177,7 +186,8 @@ compile_goal(Op(\"recur\",Args),Tail,V,[L,LL]) :- ...@@ -177,7 +186,8 @@ compile_goal(Op(\"recur\",Args),Tail,V,[L,LL]) :-
push_args_args(#f,Xin,V,L,L1,_,_), push_args_args(#f,Xin,V,L,L1,_,_),
touch_A(V), touch_A(V),
touch_Q(10,V), touch_Q(10,V),
%set_F(V,scm[(gensym \"Rec\")]), %gen_rec(Sym)
%set_F(V,Sym)
L1=[[label,A]|L2], L1=[[label,A]|L2],
compile_goal((begin_att,Impr,end_att),Tail,V,[L2,LL]). compile_goal((begin_att,Impr,end_att),Tail,V,[L2,LL]).
...@@ -222,7 +232,7 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !, ...@@ -222,7 +232,7 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
) )
). ).
compile_goal(verbatim_call(X),Tail,V,[L,LL]) :- compile_goal(verbatim_call(X),Tail,V,[L,LL]) :- !,
( \\+var_p(X), ( \\+var_p(X),
( (
F(|Args)=X -> F(|Args)=X ->
...@@ -235,7 +245,7 @@ compile_goal(verbatim_call(X),Tail,V,[L,LL]) :- ...@@ -235,7 +245,7 @@ compile_goal(verbatim_call(X),Tail,V,[L,LL]) :-
!, !,
compile_goal(X,Tail,V,[L,LL]). compile_goal(X,Tail,V,[L,LL]).
compile_goal(call(X),Tail,V,[L,LL]) :- compile_goal(call(X),Tail,V,[L,LL]) :- !,
( \\+var_p(X), ( \\+var_p(X),
( (
F(|Args)=X -> F(|Args)=X ->
...@@ -339,7 +349,6 @@ compile_goal(\\+X,Tail,V,[L,LL]) :- !, ...@@ -339,7 +349,6 @@ compile_goal(\\+X,Tail,V,[L,LL]) :- !,
), ),
( (
get_A(V,A1), get_A(V,A1),
(A==A1 -> true ; throw(mismatching_begin_end_in_negation)),
set_QACESB(V,Q,A,C,E,S,B), set_QACESB(V,Q,A,C,E,S,B),
(A=[[0|_]|_] -> Tp is 0 ; Tp is 1), (A=[[0|_]|_] -> Tp is 0 ; Tp is 1),
L = [ [Newframe,Al,Tp] |LX ], L = [ [Newframe,Al,Tp] |LX ],
...@@ -362,6 +371,7 @@ compile_goal((m_and(Op,m_or(<,>,=<,>=,=:=,=\\=,@<,@=<,@>,@>=)))(X,Y), ...@@ -362,6 +371,7 @@ compile_goal((m_and(Op,m_or(<,>,=<,>=,=:=,=\\=,@<,@=<,@>,@>=)))(X,Y),
push_v(-1,V), push_v(-1,V),
reverse_op(Op,Or), reverse_op(Op,Or),
binop1L(Or,O), binop1L(Or,O),
tr(O,OO), tr(O,OO),
LY=[[OO,EX]|LLL] LY=[[OO,EX]|LLL]
)) ))
...@@ -488,6 +498,7 @@ isApply([X|L]) :- isApply(L). ...@@ -488,6 +498,7 @@ isApply([X|L]) :- isApply(L).
ncons(X,N) :- ncons(X,N) :-
ncons(X,0,N). ncons(X,0,N).
") ")
......
...@@ -6,7 +6,8 @@ ...@@ -6,7 +6,8 @@
#:use-module (logic guile-log guile-prolog ops) #:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi) #:use-module (logic guile-log prolog swi)
#:use-module (logic guile-log guile-prolog macros) #:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var2) #:use-module (logic guile-log guile-prolog vm vm-var2)
#:use-module (logic guile-log guile-prolog vm vm-args2) #:use-module (logic guile-log guile-prolog vm vm-args2)
...@@ -19,7 +20,6 @@ ...@@ -19,7 +20,6 @@
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:export (begin_att end_att recur verbatim_call with_cut pr #:export (begin_att end_att recur verbatim_call with_cut pr
extended_off extended_on)) extended_off extended_on))
#; #;
(eval-when (compile) (eval-when (compile)
(pk (prolog-run-rewind 1 (x) (pk (prolog-run-rewind 1 (x)
......
...@@ -146,16 +146,14 @@ handle(['newvar', _],I,I,L,L) :- !. ...@@ -146,16 +146,14 @@ handle(['newvar', _],I,I,L,L) :- !.
handle([cutter,[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :- handle([cutter,[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :-
!, !,
( (
F==#t -> throw(end_with_no_begin) ; new_var(V1,Q1,S1),
( new_var(V2,Q2,S2),
new_var(V1,Q1,S1), (V1=[V1C|_] -> E1=0 ; (V1=V1C,E1=1)),
new_var(V2,Q2,S2), (V2=[V2C|_] -> E2=0 ; (V2=V2C,E2=1)),
V1=[V1C|_], E is E1 + E2 << 1,
V2=[V2C|_], VC is V1C + V2C << 16 + E << 32,
VC is V1C + V2C << 16, L=[[cutter,VC]|LL],
L=[[cutter,VC]|LL], II is I + 2
II is I + 2
)
). ).
handle(['pre-unify',At,Vx],I,II,L,LL) :- !, handle(['pre-unify',At,Vx],I,II,L,LL) :- !,
...@@ -692,8 +690,6 @@ code([push3,V1,V2,V3],Code,Action) :- ...@@ -692,8 +690,6 @@ code([push3,V1,V2,V3],Code,Action) :-
Code is V1C + V2C << 16 + V3C << 32 + A << 48, Code is V1C + V2C << 16 + V3C << 32 + A << 48,
Action = 'push-3variables-x'. Action = 'push-3variables-x'.
code3(V1,V2,V3,C) :- C is V1 + V2 << 16 + V3 << 32. code3(V1,V2,V3,C) :- C is V1 + V2 << 16 + V3 << 32.
code2(V1,V2,C) :- C is V1 + V2 << 16. code2(V1,V2,C) :- C is V1 + V2 << 16.
......
...@@ -5,7 +5,8 @@ ...@@ -5,7 +5,8 @@
#:use-module (logic guile-log guile-prolog ops) #:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi) #:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:use-module (logic guile-log guile-prolog macros) #:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var2) #:use-module (logic guile-log guile-prolog vm vm-var2)
......
...@@ -7,7 +7,8 @@ ...@@ -7,7 +7,8 @@
#:use-module (logic guile-log prolog swi) #:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var2) #:use-module (logic guile-log guile-prolog vm vm-var2)
#:export (compile_scm)) #:export (compile_scm))
......
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
#:use-module (logic guile-log prolog swi) #:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module (logic guile-log guile-prolog vm-compiler)
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var2) #:use-module (logic guile-log guile-prolog vm vm-var2)
......
...@@ -433,8 +433,9 @@ get_line([A|U],[A|X],[_|Xin],I,N) :- !, ...@@ -433,8 +433,9 @@ get_line([A|U],[A|X],[_|Xin],I,N) :- !,
get_line(_,[],[],I,I). get_line(_,[],[],I,I).
%:- dynamic([compile_goal/2]).
compile_goal. compile_goal.
:- dynamic([compile_goal/2]).
collect_F. collect_F.
newtag_F. newtag_F.
......
...@@ -8,7 +8,8 @@ ...@@ -8,7 +8,8 @@
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog macros) #:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm-compiler) #:use-module ((logic guile-log guile-prolog vm-compiler)
#:select ())
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:replace (first) #:replace (first)
#:export ()) #:export ())
......
...@@ -1180,7 +1180,7 @@ ...@@ -1180,7 +1180,7 @@
(define (test x) (define (test x)
(let ((x (module-ref (current-module) x))) (let ((x (module-ref (current-module) x)))
(if (and (procedure? x) (if (and (procedure? x)
(procedure-property x 'module)) (procedure-property x 'dynamic-directive))
#t #t
#f))) #f)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment