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

parent 2ca1b934
......@@ -41,6 +41,8 @@ SOURCES = \
logic/guile-log/dynamic-features.scm \
logic/guile-log/prolog/pre.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/names.scm \
logic/guile-log/prolog/parser.scm \
......@@ -61,7 +63,6 @@ SOURCES = \
logic/guile-log/prolog/functions.scm \
logic/guile-log/prolog/util.scm \
logic/guile-log/prolog/conversion.scm \
logic/guile-log/prolog/closed.scm \
logic/guile-log/iso-prolog.scm \
logic/guile-log/guile-prolog/continuations.scm \
logic/guile-log/guile-prolog/hash.scm \
......
Prerequisits
A 64 bit system
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
......
......@@ -1689,10 +1689,11 @@ the orders of fact1 and fact2 etc in the definitions of R1 and R2.
@node prolog
@chapter Prolog
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.
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.
@menu
* running:: How to hook in prolog code
* interpreter:: A interactive shell for prolog
* deviations:: What is different and not according to standard and why.
* modules:: How to handle name spacing
* scheme:: Hooking in scheme expressions
......@@ -1705,7 +1706,7 @@ Guile log sports also a iso-prolog interface as a logic programming interface be
@node running
@section Seting up and running prolog programs
At this point we do not support an interactive shell for prolog. A task on the todo list, but you can run macros that takes a string and outputs a compiled guile log snippet and by this e.g. define logic functions using prolog. It is also possible to refere to a file and by that load a prolog file's contents into a scheme file. There is also tools to reset the prolog parser in case it changes it's state by e.g. defining operators or character translations. The typical usecase is to provide a small module wrapper, reset the parser and then add the prolog file.
At this point compiling prolog is not supported via the general compiling framework. But you can run macros that takes a string and outputs a compiled guile log snippet and by this e.g. define logic functions using prolog. It is also possible to refere to a file and by that load a prolog file's contents into a scheme file. There is also tools to reset the prolog parser in case it changes it's state by e.g. defining operators or character translations. The typical usecase is to provide a small module wrapper, reset the parser and then add the prolog file.
@subsection Api
@findex compile-prolog-string
......@@ -1753,6 +1754,145 @@ solutions to search for, or @code{*} to search for all solutions. @code{v ...}
$1 = ((1 2) (v0 3) (v0 v0))
@end verbatim
@node interpreter
@section Interpreter
guile version >= 2.0 support an interpreter that can switch between different shells. To start the prolog interpreter use the standard way of switching the language through
@verbatim
scheme@(guile-user)> ,L prolog
Happy hacking with Prolog! To switch back, type `,L scheme'.
prolog@(guile-user)>
@end verbatim
This will have the namespce @code{guile-user}, so we need to import the prolog
code bt
@verbatim
prolog@(guile-user)> [use-modules (logic guile-log iso-prolog)]
prolog@(guile-user)>
@end verbatim
This is pretty hackable, you will have all guile and all prolog in the same environment. If you want to be more prolog centring, you can do
@verbatim
prolog@(guile-user)> default_module().
prolog@(prolog-user)>
@end verbatim
This will make sure that we hack in a module where all scheme is preficed by @code{scm-} this together with the naming conventiion in prolog to use @code{'_'} in stead of @code{'-'} we risk less mixups.
As we saw, if the first character is @code{'['}, then in everything until the next @code{]} will be treated as a scheme expression. This is handy to evaluate scheme without switching the language. What's nice is that all shell commands that guile has (prefixed with @code{','}) is preserved so that one can basically do all of
@verbatim
prolog@(guile-user)> ,h all
Help Commands [abbrev]:
,help [all | GROUP | [-c] COMMAND]
[,h] - Show help.
,show [TOPIC] - Gives information about Guile.
,apropos REGEXP [,a] - Find bindings/modules/packages.
,describe OBJ [,d] - Show description/documentation.
Module Commands [abbrev]:
,module [MODULE] [,m] - Change modules / Show current module.
,import [MODULE ...] [,use] - Import modules / List those imported.
,load FILE [,l] - Load a file in the current module.
,reload [MODULE] [,re] - Reload the given module, or the current module if none was given.
,binding [,b] - List current bindings.
,in MODULE COMMAND-OR-EXPRESSION - Evaluate an expression or command in the context of module.
Language Commands [abbrev]:
,language LANGUAGE [,L] - Change languages.
Compile Commands [abbrev]:
,compile EXP [,c] - Generate compiled code.
,compile-file FILE [,cc] - Compile a file.
,expand EXP [,exp] - Expand any macros in a form.
,optimize EXP [,opt] - Run the optimizer on a piece of code and print the result.
,disassemble EXP [,x] - Disassemble a compiled procedure.
,disassemble-file FILE [,xx] - Disassemble a file.
Profile Commands [abbrev]:
,time EXP [,t] - Time execution.
,profile EXP [,pr] - Profile execution.
,trace EXP [,tr] - Trace execution.
Debug Commands [abbrev]:
,backtrace [COUNT] [#:width W] [#:full? F]
[,bt] - Print a backtrace.
,up [COUNT] - Select a calling stack frame.
,down [COUNT] - Select a called stack frame.
,frame [IDX] [,fr] - Show a frame.
,procedure [,proc] - Print the procedure for the selected frame.
,locals - Show local variables.
,error-message [,error] - Show error message.
,break PROCEDURE [,br ,bp] - Break on calls to PROCEDURE.
,break-at-source FILE LINE
[,break-at ,bs] - Break when control reaches the given source location.
,step [,s] - Step until control reaches a different source location.
,step-instruction [,si] - Step until control reaches a different instruction.
,next [,n] - Step until control reaches a different source location in the current frame.
,next-instruction [,ni] - Step until control reaches a different instruction in the current frame.
,finish - Run until the current frame finishes.
,tracepoint PROCEDURE [,tp] - Add a tracepoint to PROCEDURE.
,traps - Show the set of currently attached traps.
,delete IDX [,del] - Delete a trap.
,disable IDX - Disable a trap.
,enable IDX - Enable a trap.
,registers [,regs] - Print registers.
Inspect Commands [abbrev]:
,inspect EXP [,i] - Inspect the result(s) of evaluating EXP.
,pretty-print EXP [,pp] - Pretty-print the result(s) of evaluating EXP.
System Commands [abbrev]:
,gc - Garbage collection.
,statistics [,stat] - Display statistics.
,option [KEY VALUE] [,o] - List/show/set options.
,quit [,q ,continue ,cont] - Quit this session.
prolog@(guile-user)>
@end verbatim
All such commands has to be the first commands in the input. But there are a set of prolog commands added (they are prefixed with @code{.}, let's see them
@verbatim
prolog@(guile-user)> .h
HELP FOR PROLOG COMMANDS
(.n ) try to find n solutions
(.all | .* ) try to find all solutions
(.once | .1 ) try to find one solution
(.mute | .m ) no value output is written.
(.save | .s ) <ref> associate current state with ref
(.load | .l ) <ref> restore associate state with ref
(.cont | .c ) continue the execution from last stall point
(.lold | .lo) load the state from the execution of the last stall command
prolog@(guile-user)>
@end verbatim
So now we can time the execution of one solution with no output by doing
@verbatim
prolog@(guile-user)> ,time .1 .m f(X,Y).
;; 0.000900s real time, 0.000836s run time. 0.000000s spent in GC.
prolog@(guile-user)>
@end verbatim
@subsection state
It is possible to store a state interactively and later retrieve the state through a mechansim that brings back control to the interpreter. You do that with
@code{prolog stall/0}. This will escape the program and return control to the shell.
in the shell you can store the state, retrieve a state and continue the execution from the actual state. Then by using global variables or user variables (preserved when storing the state) it is possible to create very nice interactive conversations for e.g. proof solvers and such. Also by using the dynamic feature framework one can contoll very fine grained how the state should be stored and restored.
@node deviations
@section Known deviations from iso prolog specification.
The known deviations are
......@@ -1774,8 +1914,7 @@ Closed files cannot be gotten through a general seek of streams.
seek in binary files is not supported (yet).
@subsection modules
there is some effort to standardize modules, we do not explicitly add module functionality to prolog, users are advised to write scheme wrappers or inlined scheme code in the prolog file/string.
there is some effort to standardize modules but its unclear how to choose, we therefore do not explicitly add module functionality to prolog, users are advised to write scheme wrappers or inlined scheme code in the prolog file/string. there are extentions to the parser to enable module aware unifications and module atoms.
@node modules
@section Module system and prolog
......@@ -1788,6 +1927,33 @@ We support @code{@@} and @code{@@@@} operators to resolve atoms module meaning.
:- scm[(re-export e f g)]
@end verbatim
@subsection module aware unification,
Strings will only in proven goals be translated to an atom in the module defining the string, else a string representation will remain. Still the evaluator understands that a string term shouled be represented by a procedure representing the predicat. The algorithm is to search in the current module runtime. But one may whish to explicitly translate strings to a correct module located predicate. The mechansim to achieve this is through the unification. The unification with respect to modules can also be used to verify that data adheres to a certain module convention. The rules for this is essentially
1) A variable in a module will if the other one is a string bind to a term/predicate found/defined in that module.
2) A term in a module will need to be proven to be defined in that module. unfourtunately it is possible that from scheme imported predicates does not declare in what module it is defined in which case we will not unify.
3) A namespaced object that is a datastructure like a list, closure etc, will make sure that all sub variables are bounded to a directly namespaced variable.
4) If a namespaced object has another namespaced object either the new one will take over or the unification fails depending on the state of the unifier to control what will happen see the api below.
subsubsection Example
@verbatim
X@@module_a = 'alpha',
[X,Y,Z@@module_b]@@module_a = ['alpha','beta','gamma']. % this may fail
@end verbatim
@subsection Controling module unification
Sigilling a variable with @code{X@@module_a} meas that we will validate the curent data of the variable. It is desireable e.g. in sandboxing, that the module environment cannot change. To control this we can use the api
@code{prolog fail_on_namespace_switch/0, ok_on_namespece_switch/0}, with the obvious semantic.
Also to get an handle to restrict and guard this information one may use,
@code{get_namespace_switch_handle(Handle)}, then if handle can be used by the dynamic features framework and make sure that we will never success although we move from state to state friously and a value can be guaranteed to be fixed inside a code segment.
@node scheme
@section hooking in scheme expressions,
We can insert scheme expressions with the construct @code{scm[sexp]}. You can insert it like
......
......@@ -58,26 +58,28 @@ Next: <a href="Index.html#Index" accesskey="n" rel="next">Index</a>, Previous: <
<hr>
<a name="Prolog"></a>
<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>
<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
</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>
<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>
<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>
<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>
<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>
<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>
<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>
<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>
</table>
......
......@@ -15,5 +15,67 @@
#:reader read-prolog
#:compilers `((tree-il . ,compile-tree-il))
#: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 @@
prolog-closure-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
(define setup-vlist #f)
(define setup-vlist #f)
(define set-closure-struct! #f)
;;need to add modded,
(catch #t
......@@ -203,6 +211,23 @@
(format port "#<vlist ~a>"
(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 vlist-null (list-ref x 0))
(define block-growth-factor (list-ref x 1))
......
......@@ -2,7 +2,7 @@
#:use-module ((logic guile-log) #:select
(<clear> <define> <let> <let*> <=> <lookup> <match> <fail>
<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 fluid)
#:use-module (logic guile-log vlist)
......@@ -16,7 +16,9 @@
#:use-module (logic guile-log 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))
(<wrap> add-fluid-dynamics -all-)
......@@ -69,6 +71,15 @@
(define -n- (@ (logic guile-log guile-prolog readline)
-n-))
(define lold #f)
(<define> (stall)
(<code> (set! lold (<state-ref>)))
(<stall>))
(<define> (thin_stall)
(<stall>))
(define *states* (make-hash-table))
(define (read-prolog port env)
(define all? #f)
......@@ -81,6 +92,7 @@
(define cont #f)
(define ref #f)
(define set #f)
(define old #f)
(let* ((l
(with-input-from-port port
(lambda ()
......@@ -111,12 +123,15 @@
((ref) (set! ref ((@ (guile) read))))
((set) (set! set (list ((@ (guile) read))
((@ (guile) read)))))
((lo lold)
(set! old #t)
(if lold (<state-set!> lold)))
(else
(set! fail? #t))))
(cond
((or fail? help?)
#f)
((or load save cont ref set)
((or load save cont ref set old)
#t)
(else
(lp #t (peek-char) '()))))
......@@ -140,6 +155,8 @@
(lp #f (peek-char) (cons ch r)))))))))
(cond
(old
'((@ (guile) if) #f #f))
(ref
`((@@ (logic guile-log guile-prolog interpreter) usr-ref) ,ref))
......
......@@ -4,7 +4,7 @@
#:use-module (logic guile-log prolog error)
#:use-module (logic guile-log prolog names)
#: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)
......
......@@ -5,7 +5,7 @@
#:use-module (logic guile-log prolog error)
#:use-module (ice-9 match)
#:replace (force)
#:export (make-unbound-fkn mk-sym
#:export (make-unbound-fkn mk-sym make-sym
;;goal
character_code
......@@ -165,6 +165,15 @@
(set-procedure-property! a 'module (module-name (current-module)))
(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 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))