middle stamp of corrections so that guile-log works with guile-2.2

parent f06f2aa6
...@@ -122,29 +122,29 @@ PSSOURCES = \ ...@@ -122,29 +122,29 @@ PSSOURCES = \
logic/guile-log/guile-prolog/gc-call.scm \ logic/guile-log/guile-prolog/gc-call.scm \
logic/guile-log/guile-prolog/coroutine.scm \ logic/guile-log/guile-prolog/coroutine.scm \
logic/guile-log/guile-prolog/attributator.scm \ logic/guile-log/guile-prolog/attributator.scm \
logic/guile-log/guile-prolog/macros.scm \ logic/guile-log/guile-prolog/macros.scm
logic/guile-log/guile-prolog/vm/vm-pre.scm \ # logic/guile-log/guile-prolog/vm/vm-pre.scm
logic/guile-log/guile-prolog/vm/vm-var.scm \ # logic/guile-log/guile-prolog/vm/vm-var.scm \
logic/guile-log/guile-prolog/vm/vm-scm.scm \ # logic/guile-log/guile-prolog/vm/vm-scm.scm \
logic/guile-log/guile-prolog/vm/vm-args.scm \ # logic/guile-log/guile-prolog/vm/vm-args.scm \
logic/guile-log/guile-prolog/vm/vm-handle.scm \ # logic/guile-log/guile-prolog/vm/vm-handle.scm \
logic/guile-log/guile-prolog/vm/vm-disj.scm \ # logic/guile-log/guile-prolog/vm/vm-disj.scm \
logic/guile-log/guile-prolog/vm/vm-conj.scm \ # logic/guile-log/guile-prolog/vm/vm-conj.scm \
logic/guile-log/guile-prolog/vm/vm-imprint.scm \ # logic/guile-log/guile-prolog/vm/vm-imprint.scm \
logic/guile-log/guile-prolog/vm/vm-unify.scm \ # logic/guile-log/guile-prolog/vm/vm-unify.scm \
logic/guile-log/guile-prolog/vm/vm-goal.scm \ # logic/guile-log/guile-prolog/vm/vm-goal.scm \
logic/guile-log/guile-prolog/vm-compiler.scm \ # logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/guile-prolog/paralell.scm \ # logic/guile-log/guile-prolog/paralell.scm \
logic/guile-log/examples/kanren/type-inference.scm \ # logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \ # logic/guile-log/imatch.scm \
language/prolog/install.scm \ # language/prolog/install.scm \
language/prolog/spec.scm \ # language/prolog/spec.scm \
language/prolog/modules/user.scm \ # language/prolog/modules/user.scm \
language/prolog/modules/sandbox.pl \ # language/prolog/modules/sandbox.pl \
language/prolog/modules/boot/expand.pl \ # language/prolog/modules/boot/expand.pl \
language/prolog/modules/boot/dcg.pl \ # language/prolog/modules/boot/dcg.pl \
language/prolog/modules/boot/if.pl \ # language/prolog/modules/boot/if.pl \
prolog-user.scm # prolog-user.scm
# logic/guile-log/guile-prolog/vm/vm-var2.scm \ # logic/guile-log/guile-prolog/vm/vm-var2.scm \
# logic/guile-log/guile-prolog/vm/vm-scm2.scm \ # logic/guile-log/guile-prolog/vm/vm-scm2.scm \
# logic/guile-log/guile-prolog/vm/vm-args2.scm \ # logic/guile-log/guile-prolog/vm/vm-args2.scm \
......
(define-module (logic guile-log guile-log-pre) (define-module (logic guile-log guile-log-pre)
#:use-module (system syntax) #:use-module ((system syntax) #:select (syntax-local-binding))
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:export (define-guile-log guile-log-macro? log-code-macro log-code-macro? #:export (define-guile-log guile-log-macro? log-code-macro log-code-macro?
define-and-log and-log-macro? bounded-equal? stx-case)) define-and-log and-log-macro? bounded-equal? stx-case))
......
#| #|
Load this code in guile with clambda defined and it will generate a prolog-vm Load this code in guile with clambda defined and it will generate a prolog-vm
stub that is linked into the guile-log shared library the good thing with this system is that the generated c-engine is synchronized with the scheme and prolog code. This makes the numbering of the labels quite robust and fault tolerant. stub that is linked into the guile-log shared library the good thing with this
system is that the generated c-engine is synchronized with the scheme and
prolog code. This makes the numbering of the labels quite robust and fault
tolerant.
you need to load this file in guile with clambda and guile-log in the path. you need to load this file in guile with clambda and guile-log in the path.
Then you will generte a file called prolog-vm.c which should be placed in the Then you will generte a file called prolog-vm.c which should be placed in the
...@@ -1909,10 +1912,12 @@ constant = #(nlocals nstack constants code) ...@@ -1909,10 +1912,12 @@ constant = #(nlocals nstack constants code)
(SCM scut (<scm> 0)) (SCM scut (<scm> 0))
(int iter (<c> 0))) (int iter (<c> 0)))
#:defs ((define-syntax-rule (get vc e) (
(define-syntax-rule (get vc e)
(<if> e (<if> e
(<ref> variables vc) (<ref> variables vc)
(SVAR-REF fp nstack vc)))) (SVAR-REF fp nstack vc)))
)
(UNPACK-ENV free narg nlocals) (UNPACK-ENV free narg nlocals)
......
...@@ -599,7 +599,7 @@ ...@@ -599,7 +599,7 @@
(#,(G list) (#,(G list)
#,@vstx) #,closed?))))) #,@vstx) #,closed?)))))
parent)))) parent))))
(ppp 'res #`(let () #,@ini (#,nm #,@vstx)))) (pp 'res #`(let () #,@ini (#,nm #,@vstx))))
(with-syntax (((lam-def ...) (with-syntax (((lam-def ...)
(let lp ((l (fluid-ref lambdas))) (let lp ((l (fluid-ref lambdas)))
(match l (match l
...@@ -614,7 +614,7 @@ ...@@ -614,7 +614,7 @@
(let* ((syms (get-syms)) (let* ((syms (get-syms))
(syms (union syms syms))) (syms (union syms syms)))
(ppp 'res #`(begin (pp 'res #`(begin
#,@mod #,@mod
(eval-when (compile load eval) (eval-when (compile load eval)
(add-non-defined (add-non-defined
......
...@@ -945,7 +945,7 @@ floor(x) (floor x) ...@@ -945,7 +945,7 @@ floor(x) (floor x)
(mk-test tr-var var -var x (attvar? x)) (mk-test tr-var var -var x (attvar? x))
(mk-test tr-atom atom -atom x (let ((y (<lookup> x))) (mk-test tr-atom atom -atom x (let ((y (<lookup> x)))
(or (symbol? y) (string? y) (or (string? y)
(procedure? y) (procedure? y)
(char? y) (char? y)
(null? y)))) (null? y))))
......
...@@ -142,6 +142,8 @@ inline void enlarge_csstack(struct gp_stack *gp, int N, int NN) ...@@ -142,6 +142,8 @@ inline void enlarge_csstack(struct gp_stack *gp, int N, int NN)
} }
} }
static int isBefore = 1;
#ifdef HAS_GP_GC #ifdef HAS_GP_GC
int gp_gc_counter = 0; int gp_gc_counter = 0;
inline void gp_gc_inc(struct gp_stack *gp) inline void gp_gc_inc(struct gp_stack *gp)
...@@ -218,8 +220,6 @@ inline void gp_gc_inc(struct gp_stack *gp) ...@@ -218,8 +220,6 @@ inline void gp_gc_inc(struct gp_stack *gp)
} }
} }
} }
static int isBefore = 1;
#else #else
inline void gp_gc_inc(struct gp_stack *gp) inline void gp_gc_inc(struct gp_stack *gp)
{ {
......
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