made a faster compiler by skipping data

parent 1ca0dfad
...@@ -78,6 +78,7 @@ PSSOURCES = \ ...@@ -78,6 +78,7 @@ PSSOURCES = \
logic/guile-log/prolog/goal-functors.scm \ logic/guile-log/prolog/goal-functors.scm \
logic/guile-log/prolog/modules.scm \ logic/guile-log/prolog/modules.scm \
logic/guile-log/prolog/compile.scm \ logic/guile-log/prolog/compile.scm \
logic/guile-log/prolog/compile2.scm \
logic/guile-log/prolog/analyze.scm \ logic/guile-log/prolog/analyze.scm \
logic/guile-log/prolog/dynamic.scm \ logic/guile-log/prolog/dynamic.scm \
logic/guile-log/prolog/directives.scm \ logic/guile-log/prolog/directives.scm \
......
...@@ -22,4 +22,4 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) ...@@ -22,4 +22,4 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
SUFFIXES = .scm .go SUFFIXES = .scm .go
.scm.go: .scm.go:
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" $(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile -O0 $(GUILE_WARNINGS) -o "$@" "$<"
...@@ -320,7 +320,11 @@ generate_stx(STX,X,F) :- ...@@ -320,7 +320,11 @@ generate_stx(STX,X,F) :-
(apply gg x))))) (apply gg x)))))
n))))))) n)))))))
(define (mk-lam f)
(lambda ()
(lambda (s p cc cut scut x)
(apply f s p cc cut scut x))))
(define (mockalambda source? s pat code) (define (mockalambda source? s pat code)
(let* ((Cut (gp-var! s)) (let* ((Cut (gp-var! s))
(SCut (gp-var! s)) (SCut (gp-var! s))
...@@ -341,10 +345,7 @@ generate_stx(STX,X,F) :- ...@@ -341,10 +345,7 @@ generate_stx(STX,X,F) :-
((@ (guile) catch) #t ((@ (guile) catch) #t
(lambda () (lambda ()
(if (pair? comp) (if (pair? comp)
#`(lambda () #`(mk-lam #,(car comp))
(let ((f #,(car comp)))
(lambda (s p cc cut scut x)
(apply f s p cc cut scut x))))
(begin (begin
(warn "failed compiling") (warn "failed compiling")
#'(lambda () (error "misscompiled"))))) #'(lambda () (error "misscompiled")))))
......
...@@ -12,7 +12,6 @@ cat(F,G) :- ...@@ -12,7 +12,6 @@ cat(F,G) :-
) )
)). )).
collect_disj([],U,U). collect_disj([],U,U).
collect_disj(['*->'(A,B)|L],U,UU) :- collect_disj(['*->'(A,B)|L],U,UU) :-
...@@ -175,4 +174,3 @@ compile_disjunction(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,V,[L,LL]) :- ...@@ -175,4 +174,3 @@ compile_disjunction(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,V,[L,LL]) :-
) )
)). )).
") ")
...@@ -18,6 +18,9 @@ ...@@ -18,6 +18,9 @@
(dyntrace (@@ (logic guile-log guile-prolog vm vm-goal) (dyntrace (@@ (logic guile-log guile-prolog vm vm-goal)
compile_goal)))) compile_goal))))
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #f))
(compile-prolog-string (compile-prolog-string
" "
- eval_when(compile). - eval_when(compile).
...@@ -26,3 +29,6 @@ the_tr2(X,[X]). ...@@ -26,3 +29,6 @@ the_tr2(X,[X]).
") ")
(include-from-path "logic/guile-log/guile-prolog/vm/vm-disj-model.scm") (include-from-path "logic/guile-log/guile-prolog/vm/vm-disj-model.scm")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #t))
...@@ -17,6 +17,8 @@ ...@@ -17,6 +17,8 @@
gp-make-var gp-var? gp-lookup)) gp-make-var gp-var? gp-lookup))
#:export (compile-prolog)) #:export (compile-prolog))
(define include-meta #t)
(define (default-extensions) (define (default-extensions)
(list prolog-and 'and prolog-or 'or prolog-not 'not prolog=.. '=..)) (list prolog-and 'and prolog-or 'or prolog-not 'not prolog=.. '=..))
...@@ -46,6 +48,15 @@ ...@@ -46,6 +48,15 @@
(pretty-print (syntax->datum x))) (pretty-print (syntax->datum x)))
x))) x)))
(define (make-vars n)
(let lp ((i 0) (r '()))
(if (< i n)
(lp (+ i 1)
(cons
((@ (logic guile-log umatch) gp-make-var))
r))
r)))
(define (ident? x) (define (ident? x)
(or (char? x) (or (char? x)
(boolean? x) (boolean? x)
...@@ -664,7 +675,9 @@ ...@@ -664,7 +675,9 @@
(append varq ovarq)) (append varq ovarq))
((@@ (logic guile-log functional-database) ((@@ (logic guile-log functional-database)
<lambda-dyn-meta>) ,aa <lambda-dyn-meta>) ,aa
,(list (G cons) `,aaa `,fff)))))) ,(if include-meta
(list (G cons) `,aaa `,fff)
(list (G cons) `(list) `(list))))))))
(fast-compile? (fast-compile?
(pp 'comp (pp 'comp
...@@ -702,6 +715,7 @@ ...@@ -702,6 +715,7 @@
(current-module)) (current-module))
(compile (src (list (G lambda)) '()) (compile (src (list (G lambda)) '())
#:env (current-module)))))) #:env (current-module))))))
(define (lamlam lam) (define (lamlam lam)
(lambda (f) (lambda (f)
(lam f))) (lam f)))
...@@ -723,8 +737,7 @@ ...@@ -723,8 +737,7 @@
ffkn) ffkn)
(map (lambda (x) #'((@ (logic guile-log umatch) (map (lambda (x) #'((@ (logic guile-log umatch)
gp-make-var))) gp-make-var)))
(append vars ovars)))))) (append vars ovars))))))
(apply lam (apply lam
(append ffkn (map (lambda (x) (gp-make-var)) (append ffkn (map (lambda (x) (gp-make-var))
(append vars ovars))))))) (append vars ovars)))))))
......
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