namespace unification core code coded, remains to hook into C unifyer and prolog parser

parent 2ca1b934
...@@ -41,6 +41,8 @@ SOURCES = \ ...@@ -41,6 +41,8 @@ SOURCES = \
logic/guile-log/dynamic-features.scm \ logic/guile-log/dynamic-features.scm \
logic/guile-log/prolog/pre.scm \ logic/guile-log/prolog/pre.scm \
logic/guile-log/prolog/error.scm \ logic/guile-log/prolog/error.scm \
logic/guile-log/prolog/closed.scm \
logic/guile-log/prolog/namespace.scm \
logic/guile-log/prolog/symbols.scm \ logic/guile-log/prolog/symbols.scm \
logic/guile-log/prolog/names.scm \ logic/guile-log/prolog/names.scm \
logic/guile-log/prolog/parser.scm \ logic/guile-log/prolog/parser.scm \
...@@ -61,7 +63,6 @@ SOURCES = \ ...@@ -61,7 +63,6 @@ SOURCES = \
logic/guile-log/prolog/functions.scm \ logic/guile-log/prolog/functions.scm \
logic/guile-log/prolog/util.scm \ logic/guile-log/prolog/util.scm \
logic/guile-log/prolog/conversion.scm \ logic/guile-log/prolog/conversion.scm \
logic/guile-log/prolog/closed.scm \
logic/guile-log/iso-prolog.scm \ logic/guile-log/iso-prolog.scm \
logic/guile-log/guile-prolog/continuations.scm \ logic/guile-log/guile-prolog/continuations.scm \
logic/guile-log/guile-prolog/hash.scm \ logic/guile-log/guile-prolog/hash.scm \
......
Prerequisits Prerequisits
A 64 bit system
This is a draft for guile-2.0.6 and later and works for linux. This is a draft for guile-2.0.6 and later and works for linux.
You need to have guile-syntax-parse installed into the system You need to have guile-syntax-parse installed into the system
......
This diff is collapsed.
...@@ -58,26 +58,28 @@ Next: <a href="Index.html#Index" accesskey="n" rel="next">Index</a>, Previous: < ...@@ -58,26 +58,28 @@ Next: <a href="Index.html#Index" accesskey="n" rel="next">Index</a>, Previous: <
<hr> <hr>
<a name="Prolog"></a> <a name="Prolog"></a>
<h2 class="chapter">10 Prolog</h2> <h2 class="chapter">10 Prolog</h2>
<p>Guile log sports also a iso-prolog interface as a logic programming interface besides kanren. The interface is pretty complete at this point appart a few points that have not yet been resolved but shure it is alpha software. With this most programs written in iso prolog should work. The intention is to enhance this interface so that the bulk of already written prolog programs should be able to be run on guile. We will also add the fetures unique to guile-log and hence enhance the prolog experience. Featurewise guile-log prolog is taking over many properties of scheme like closures, continuations, delimeted continuations, the interleaving constructs of kanren and a delicate system to treat dynamic objects like dynamic functions, dynamic hashes and a well thought out library to tell how you want the dynamism to work at a very fine grained level. <p>Guile log also sports an iso-prolog interface as a logic programming interface besides kanren. The interface is pretty complete at this point appart a few points that have not yet been resolved but sure it is currently alpha software and help is very very much appriciated. With this most programs written in iso prolog should probably work. The intention is to enhance this interface so that the bulk of already written prolog programs should be able to run on guile. We will also add the fetures unique to guile-log and hence enhance the prolog experience. Featurewise guile-log prolog is taking over many properties of scheme like closures, continuations, delimeted continuations, the interleaving constructs of kanren and a delicate system to treat dynamic objects like dynamic functions, dynamic hashes and a library to tell how you want the dynamism to work at a fine grained level.
</p> </p>
<table class="menu" border="0" cellspacing="0"> <table class="menu" border="0" cellspacing="0">
<tr><td align="left" valign="top">&bull; <a href="running.html#running" accesskey="1">running</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">How to hook in prolog code <tr><td align="left" valign="top">&bull; <a href="running.html#running" accesskey="1">running</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">How to hook in prolog code
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="deviations.html#deviations" accesskey="2">deviations</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">What is different and not according to standard and why. <tr><td align="left" valign="top">&bull; <a href="interpreter.html#interpreter" accesskey="2">interpreter</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">A interactive shell for prolog
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="modules.html#modules" accesskey="3">modules</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">How to handle name spacing <tr><td align="left" valign="top">&bull; <a href="deviations.html#deviations" accesskey="3">deviations</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">What is different and not according to standard and why.
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="scheme.html#scheme" accesskey="4">scheme</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Hooking in scheme expressions <tr><td align="left" valign="top">&bull; <a href="modules.html#modules" accesskey="4">modules</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">How to handle name spacing
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="closures.html#closures" accesskey="5">closures</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Using closures in prolog <tr><td align="left" valign="top">&bull; <a href="scheme.html#scheme" accesskey="5">scheme</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Hooking in scheme expressions
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="prolog_002ddynamic_002dfunctions.html#prolog_002ddynamic_002dfunctions" accesskey="6">prolog-dynamic-functions</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">A discussion of guile log&rsquo;s version of this <tr><td align="left" valign="top">&bull; <a href="closures.html#closures" accesskey="6">closures</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Using closures in prolog
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="dynamic_002dfeatures.html#dynamic_002dfeatures" accesskey="7">dynamic-features</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Special construct to manage dynamic objects <tr><td align="left" valign="top">&bull; <a href="prolog_002ddynamic_002dfunctions.html#prolog_002ddynamic_002dfunctions" accesskey="7">prolog-dynamic-functions</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">A discussion of guile log&rsquo;s version of this
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="prolog_002dlibraries.html#prolog_002dlibraries" accesskey="8">prolog-libraries</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Libraries that exposes guile-log features <tr><td align="left" valign="top">&bull; <a href="dynamic_002dfeatures.html#dynamic_002dfeatures" accesskey="8">dynamic-features</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Special construct to manage dynamic objects
</td></tr> </td></tr>
<tr><td align="left" valign="top">&bull; <a href="internals.html#internals" accesskey="9">internals</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">A short discussion of the prolog internals used. <tr><td align="left" valign="top">&bull; <a href="prolog_002dlibraries.html#prolog_002dlibraries" accesskey="9">prolog-libraries</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">Libraries that exposes guile-log features
</td></tr>
<tr><td align="left" valign="top">&bull; <a href="internals.html#internals">internals</a>:</td><td>&nbsp;&nbsp;</td><td align="left" valign="top">A short discussion of the prolog internals used.
</td></tr> </td></tr>
</table> </table>
......
...@@ -15,5 +15,67 @@ ...@@ -15,5 +15,67 @@
#:reader read-prolog #:reader read-prolog
#:compilers `((tree-il . ,compile-tree-il)) #:compilers `((tree-il . ,compile-tree-il))
#:evaluator (lambda (x module) (primitive-eval x)) #:evaluator (lambda (x module) (primitive-eval x))
#:printer write) #:printer write
#:make-default-environment
(lambda ()
(let ((m (make-module)))
(define (--f--)
(let ((spec-mod (resolve-module '(language prolog spec))))
(define! 'use-modules #f)
(module-set! (current-module) 'use-modules
(module-ref spec-mod 'patched-use-modules))
(use-modules ((guile) #:renamer (symbol-prefix-proc 'scm-)))))
(set-module-name! m '(prolog-user))
(module-use! m (module-public-interface
(resolve-module '(logic guile-log iso-prolog))))
(save-module-excursion
(lambda ()
(set-current-module m)
(--f--)))
m)))
(define (ask str ok?)
(let lp ()
(format #t "~%~a" str)
(let ((ans ((@@ (logic guile-log guile-prolog readline) readline_))))
(if (ok? (with-input-from-string ans (lambda () (read))))
#t
(begin
(format #t "wrong input!")
(lp))))))
(define-syntax-rule (patched-use-modules . l)
(let ((mod (current-module))
(patch (make-module)))
(save-module-excursion
(lambda ()
(set-current-module patch)
(use-modules . l)))
(let ((yall? #f)
(nall? #f))
(for-each-module
(lambda (k v)
(when (module-defined? old k)
(if yall? (module-define! k v))
(if nall?
#t
(ask (format
#f "'~a' already defined, overwrite? (y/n/yall/nall)> " k)
(lambda (x)
(cond
((equal? x 'yall')
(set! yall? #t)
(set! x 'y))
((equal? x 'nall)
(set! nall? #t)
(set! x 'y)))
(cond
((equal? x 'y)
(module-define! k v)
#t)
((equal? x 'n)
#t)
(else
#f)))))))))))
\ No newline at end of file
...@@ -79,11 +79,19 @@ ...@@ -79,11 +79,19 @@
prolog-closure-closed? prolog-closure-closed?
setup-closed setup-closed
make-namespace
namespace?
namespace-val
namespace-ns
namespace-local?
setup-namespace
<namespace-type>
)) ))
;; Tos silence the compiler, those are fetched from the .so file ;; Tos silence the compiler, those are fetched from the .so file
(define setup-vlist #f) (define setup-vlist #f)
(define set-closure-struct! #f)
;;need to add modded, ;;need to add modded,
(catch #t (catch #t
...@@ -203,6 +211,23 @@ ...@@ -203,6 +211,23 @@
(format port "#<vlist ~a>" (format port "#<vlist ~a>"
(vlist->list vl)))))) (vlist->list vl))))))
(define-record-type <namespace-type>
(make-namespace val ns local?)
namespace?
(val namespace-val)
(ns namespace-ns)
(local? namespace-local?))
(set-record-type-printer!
<namespace-type>
(lambda (vl port)
(let ((li (namespace-ns vl))
(l? (namespace-local? vl))
(x (namespace-val vl)))
(if l?
(format port "~a@@~a" x li)
(format port "~a@~a" x li)))))
(define x (setup-vlist <vlist>)) (define x (setup-vlist <vlist>))
(define vlist-null (list-ref x 0)) (define vlist-null (list-ref x 0))
(define block-growth-factor (list-ref x 1)) (define block-growth-factor (list-ref x 1))
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
#:use-module ((logic guile-log) #:select #:use-module ((logic guile-log) #:select
(<clear> <define> <let> <let*> <=> <lookup> <match> <fail> (<clear> <define> <let> <let*> <=> <lookup> <match> <fail>
<cut> <wrap> <state-ref> <state-set!> <continue> <cut> <wrap> <state-ref> <state-set!> <continue>
<code> <scm>)) <code> <scm> <stall>))
#:use-module (logic guile-log guile-prolog hash) #:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog fluid) #:use-module (logic guile-log guile-prolog fluid)
#:use-module (logic guile-log vlist) #:use-module (logic guile-log vlist)
...@@ -16,7 +16,9 @@ ...@@ -16,7 +16,9 @@
#:use-module (logic guile-log dynamic-features) #:use-module (logic guile-log dynamic-features)
#:use-module (logic guile-log guile-prolog dynamic-features) #:use-module (logic guile-log guile-prolog dynamic-features)
#:export (prolog-shell conversation leave read-prolog user_ref user_set)) #:export (prolog-shell conversation leave read-prolog user_ref user_set
stall thin_stall))
(define -all- (make-fluid false)) (define -all- (make-fluid false))
(<wrap> add-fluid-dynamics -all-) (<wrap> add-fluid-dynamics -all-)
...@@ -69,6 +71,15 @@ ...@@ -69,6 +71,15 @@
(define -n- (@ (logic guile-log guile-prolog readline) (define -n- (@ (logic guile-log guile-prolog readline)
-n-)) -n-))
(define lold #f)
(<define> (stall)
(<code> (set! lold (<state-ref>)))
(<stall>))
(<define> (thin_stall)
(<stall>))
(define *states* (make-hash-table)) (define *states* (make-hash-table))
(define (read-prolog port env) (define (read-prolog port env)
(define all? #f) (define all? #f)
...@@ -81,6 +92,7 @@ ...@@ -81,6 +92,7 @@
(define cont #f) (define cont #f)
(define ref #f) (define ref #f)
(define set #f) (define set #f)
(define old #f)
(let* ((l (let* ((l
(with-input-from-port port (with-input-from-port port
(lambda () (lambda ()
...@@ -111,12 +123,15 @@ ...@@ -111,12 +123,15 @@
((ref) (set! ref ((@ (guile) read)))) ((ref) (set! ref ((@ (guile) read))))
((set) (set! set (list ((@ (guile) read)) ((set) (set! set (list ((@ (guile) read))
((@ (guile) read))))) ((@ (guile) read)))))
((lo lold)
(set! old #t)
(if lold (<state-set!> lold)))
(else (else
(set! fail? #t)))) (set! fail? #t))))
(cond (cond
((or fail? help?) ((or fail? help?)
#f) #f)
((or load save cont ref set) ((or load save cont ref set old)
#t) #t)
(else (else
(lp #t (peek-char) '())))) (lp #t (peek-char) '()))))
...@@ -140,6 +155,8 @@ ...@@ -140,6 +155,8 @@
(lp #f (peek-char) (cons ch r))))))))) (lp #f (peek-char) (cons ch r)))))))))
(cond (cond
(old
'((@ (guile) if) #f #f))
(ref (ref
`((@@ (logic guile-log guile-prolog interpreter) usr-ref) ,ref)) `((@@ (logic guile-log guile-prolog interpreter) usr-ref) ,ref))
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
#:use-module (logic guile-log prolog error) #:use-module (logic guile-log prolog error)
#:use-module (logic guile-log prolog names) #:use-module (logic guile-log prolog names)
#:use-module (logic guile-log dynamic-features) #:use-module (logic guile-log dynamic-features)
#:export(closed_closure error_at_closed_p_handle close_error_true close_error_false)) #:export(closed_closure error_at_closed_p_handle close_error_true close_error_false error-when-closed?))
(mk-sym closed_closure) (mk-sym closed_closure)
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
#:use-module (logic guile-log prolog error) #:use-module (logic guile-log prolog error)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:replace (force) #:replace (force)
#:export (make-unbound-fkn mk-sym #:export (make-unbound-fkn mk-sym make-sym
;;goal ;;goal
character_code character_code
...@@ -165,6 +165,15 @@ ...@@ -165,6 +165,15 @@
(set-procedure-property! a 'module (module-name (current-module))) (set-procedure-property! a 'module (module-name (current-module)))
(set-procedure-property! a 'name 'a))) (set-procedure-property! a 'name 'a)))
(define (make-sym mod a)
(if (not (module-defined? mod a))
(let ((f (make-unbound-fkn a)))
(module-define! mod a f)
(set-procedure-property! f 'module (module-name (current-module)))
(set-procedure-property! f 'name a)
f)
#f))
(mk-sym is-a-num?) (mk-sym is-a-num?)
(mk-sym check-num) (mk-sym check-num)
......
(define-module (logic guile-log prolog namespace)
#:use-module (logic guile-log code-load)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prolog closed)
#:use-module (logic guile-log prolog names)
#:use-module (ice-9 match)
#:export (ns-it))
#|
Unification that varifies namespaces in a unification e.g. we can do
X@@a = Y
X@ = current open module
Two things will happen
1) Var = string, will be translated to an actual function in a lookup
for the namespace
2) Var = atom, atom have to be in the namespaced module.
3) new namespaces found changes the restricted namespace
|#
(define fail-when-new-namespace? (make-fluid #f))
(define (comp-fail? ns1 local1? ns2 local2?)
(let ((fail (fluid-ref fail-when-new-namespace?)))
(if (and (equal? ns1 ns2) (or local1? (not local2?)))
#f
(if fail
(if (eq? fail #t)
#t
(let lp-wl ((l fail))
(match l
(((local? . dir) . l)
(if (or local? (not local2?))
(let lp ((dir dir) (ns ns2))
(match dir
((*) #f)
(() (if (null? ns)
#f
(lp-wl l)))
((x . dir)
(match ns
((y . ns)
(if (equal? x y)
(lp dir ns)
(lp-wl l)))
(_ (lp-wl l))))))
(lp-wl l)))
(() #t))))
#f))))
(define (translate x ns l?)
(let ((sym (string->symbol x))
(mod (resolve-module ns)))
(if l?
(if (module-defined? mod sym)
(module-ref mod sym)
(let ((f (make-sym mod sym)))
(module-define! mod sym f)
f))
(let ((pub (module-public-interface mod)))
(if (module-defined? pub sym)
(module-ref pub sym)
(let ((f (make-sym mod sym)))
(module-define! mod sym f)
(module-set! pub sym (module-ref mod sym))
f))))))
(define (ns-it x ns local? s)
(define (f x s cont)
(cond
((prolog-closure? x)
(if (ns-it (prolog-closure-parent x) ns local? s)
(ns-it (prolog-closure-state x) ns local? s)
#f))
((namespace? x)
(if (comp-fail? ns local? (namespace-ns x) (namespace-local? x))
#f
s))
((vector? x)
(ns-it (vector->list x) ns local? s))
((gp-var? x s)
(gp-unify! x (make-namespace (gp-var! s) ns local?) s))
((procedure? x)
(let ((mod (procedure-property x 'module)))
(if mod
(if (equal? mod ns)
(if (not local?)
(if (module-defined?
(module-public-interface (resolve-module mod))
(procedure-name x))
s
#f)
s)
#f)
#f)))
(else
(cont x s))))
(f x s
(lambda (x s)
(let lp ((s s) (x x))
(umatch (#:mode - #:status s #:name ns-it) (x)
((x . l)
(let ((s (ns-it (gp-lookup x s) ns local? s)))
(if s
(lp s (gp-lookup l s))
s)))
(x (f x s (lambda (x s) s))))))))
(define (ns-unify s ns y)
(let ((x (namespace-val ns))
(ns (namespace-ns ns))
(lx? (namespace-local? ns)))
(let ((s (ns-it x ns lx? s)))
(if s
(let lp ((x (gp-lookup x s)) (y (gp-lookup y s))
(ns-x ns) (ns-y #f)
(lx? lx?) (ly? #f)
(x? #t) (y? #f) (s s))
(cond
((namespace? y)
(let ((ns-y2 (namespace-ns y))
(ly2? (namespace-local? y)))
(if (comp-fail? ns-y ly? ns-y2 ly2?)
#f
(lp x (gp-lookup (namespace-val y) s)
ns-x ns-y2
lx? ly2?
x? y s))))
((namespace? x)
(let ((ns-x2 (namespace-ns x))
(lx2? (namespace-local? x)))
(if (comp-fail? ns-x lx? ns-x2 lx2?)
#f
(lp (gp-lookup (namespace-val x) s) y
ns-x2 ns-y
lx2? ly?
x? x s))))
(else
(if (and (equal? ns-x ns-y) (eq? lx? ly?))
(cond
((gp-var? x s)
(if (gp-var? y s)
(cond
((and x? y?)
(gp-unify! x y s))
(x?
(gp-unify! x? y s))
(y?
(gp-unify! y? x s))
(else
(let ((s (gp-unify! x y s)))
(if s
(gp-unify! x
(make-namespace (gp-var! s) ns-x lx?)
s)
s))))
))
(imprint! x y ns-x lx? s)
((gp-var? y s)
(imprint! y x ly? lx? s))
((or (vector? x) (vector? y))
(if (and (vector? x) (vector? y))
(lp (vector->list x) (vector->list y) ns-x ns-y lx? ly?
x? y? s)
#f))
((or (procedure? x) (procedure? y))
(if (eq? (procedure? x) (procedure? y))
s
#f))
((or (prolog-closure? x) (prolog-closure? y))
(if (and (prolog-closure? x) (prolog-closure? y))
(if (eq? (prolog-closure-parent x)
(prolog-closure-parent y))
(lp (prolog-closure-state x)
(prolog-closure-state y)
ns-x ns-y lx? ly? x? y? s)
(if (fluid-ref error-when-closed?)
((@@ (logic guile-log prolog closed) err)
x y)
#f))))
(else
(umatch (#:mode - #:status s #:name ns-1) (x y)
((xa . xl) (ya . yl)
(let lp-x ((s s) (x x) (y y))
(umatch (#:mode - #:status s #:name ns-2) (x y)
((xa . xl) (ya . yl)
(lp-x (lp xa ya ns-x ns-y lx? ly? #f #f s)
xl yl))
(x y
(lp x y ns-x ns-y lx? ly? #f #f s)))))
(x y
(if (equal? x y)
s
#f)))))
#f))))
#f))))
(define (imprint! x y ns lx? s)
(let lp ((s s) (y (gp-lookup y s)) (x (gp-lookup x s)))
(if (gp-var? y s)
(gp-unify! x y s)
(umatch (#:mode + #:status s #:name imprint!) (y x)
((y . ly) (x . lx)
(lp (lp s y x) ly lx))
(_ _
(cond
((vector? y)
(let* ((xx (gp-var! s))
(ly (vector->list y))
(lx (map (lambda (x) (gp-var! s)) ly)))
(gp-unify! x (list->vector lx)
(lp s ly lx))))
((string? y)
(gp-unify! x (translate y ns lx?) s))
((prolog-closure? y)
(let* ((xx (gp-var! s))
(ly (prolog-closure-state y))
(lx (map (lambda (x) (gp-var! s)) ly)))
(gp-unify! x (make-prolog-closure
(prolog-closure-closure y)
(prolog-closure-parent y)
lx
(prolog-closure-closed? y))
(lp s ly lx))))
((namespace? y)
(let ((ns2 (namespace-ns y))
(lx2? (namespace-local? y)))
(if (comp-fail? ns lx? ns2 lx2?)
#f
(imprint! x y ns2 lx2? s))))
(else
(gp-unify! x y s))))))))
(setup-namespace <namespace-type> ns-unify)
...@@ -903,6 +903,19 @@ SCM_DEFINE(gp_setup_closed, "setup-closed",1,0,0,(SCM err), ...@@ -903,6 +903,19 @@ SCM_DEFINE(gp_setup_closed, "setup-closed",1,0,0,(SCM err),
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM namespace_fkn = SCM_BOOL_F;
SCM namespace_struct = SCM_BOOL_F;
SCM_DEFINE(gp_setup_namespace, "setup-namespace",2,0,0,(SCM record, SCM nsfkn),
"supplies the record for the namespace struct and the name space unification function")
#define FUNC_NAME s_setup_namespace
{
namespace_fkn = nsfkn;
namespace_struct = record;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
static int gp_recurent(SCM *id1,SCM *id2, SCM *l) static int gp_recurent(SCM *id1,SCM *id2, SCM *l)
{ {
SCM scm; SCM scm;
......
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
#include "vlist/vlist.h" #include "vlist/vlist.h"
#include "indexer/indexer.h" #include "indexer/indexer.h"
SCM_API SCM gp_setup_namespace(SCM record, SCM nsfkn);
SCM_API SCM gp_setup_closed(SCM err); SCM_API SCM gp_setup_closed(SCM err);
SCM_API SCM gp_set_closure_struct(SCM scm); SCM_API SCM gp_set_closure_struct(SCM scm);
SCM_API SCM gp_gp(SCM scm); SCM_API SCM gp_gp(SCM scm);
......
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
#include<stdio.h> #include<stdio.h>
#define VLIST 0 #define VLIST 0
#define VHASH 1 #define VHASH 1
// This code only works on 64 bit systems
void vhash_truncate_x(SCM vhash); void vhash_truncate_x(SCM vhash);
void vhash_block_clear(SCM *base, int offset); void vhash_block_clear(SCM *base, int offset);
...@@ -57,9 +58,9 @@ SCM vhash_cache = SCM_BOOL_F; ...@@ -57,9 +58,9 @@ SCM vhash_cache = SCM_BOOL_F;
#define NEXT_REF(x) ((int) LOW(x)) #define NEXT_REF(x) ((int) LOW(x))
#define COMB_REFS(low,high) ((((ulong) high) << TAGN) | ((ulong) ((uint) low))) #define COMB_REFS(low,high) ((((ulong) high) << TAGN) | ((ulong) ((uint) low)))
#define NEXTFREE(x) ((int) LOW(x)) #define NEXTFREE(x) ((int) LOW(x))
#define INCREF(x) (x + (1L << TAGN)) #define INCREF(x) ((ulong) (x + (1L << TAGN)))
#define DECREF(x) (x - (1L << TAGN)) #define DECREF(x) ((ulong) (x - (1L << TAGN)))
#define REFCOUNT(x) ((x) & TAGU(TAGN)) #define REFCOUNT(x) ((ulong) ((x) & TAGU(TAGN)))
SCM thread_seq_number; SCM thread_seq_number;
SCM thread_id; SCM thread_id;
SCM thread_inc; SCM thread_inc;
...@@ -301,7 +302,7 @@ inline void vlist_truncate_x(SCM vlist) ...@@ -301,7 +302,7 @@ inline void vlist_truncate_x(SCM vlist)
SCM* base = vlist_base(vlist); SCM* base = vlist_base(vlist);
int offset = vlist_offset(vlist); int offset = vlist_offset(vlist);
ulong freeref = my_scm_to_ulong(block_next_free_ref(base)); ulong freeref = my_scm_to_ulong(block_next_free_ref(base));
int count = REFCOUNT(freeref); ulong count = REFCOUNT(freeref);
ulong seq = my_scm_to_ulong(scm_fluid_ref(thread_seq_number)); ulong seq = my_scm_to_ulong(scm_fluid_ref(thread_seq_number));
ulong thr = my_scm_to_ulong(scm_fluid_ref(thread_id)); ulong thr = my_scm_to_ulong(scm_fluid_ref(thread_id));
...@@ -310,6 +311,8 @@ inline void vlist_truncate_x(SCM vlist) ...@@ -310,6 +311,8 @@ inline void vlist_truncate_x(SCM vlist)