clpfd compiles again

parent eba21a9b
......@@ -129,7 +129,7 @@
clpfd_equal/2,
clpfd_geq/2.
%:- use_module(library(apply_macros)).
:- use_module(library(apply)).
:- use_module(library(assoc)).
:- use_module(library(error)).
:- use_module(library(lists)).
......@@ -2971,11 +2971,13 @@ props_number(fd_props(Gs,Bs,Os), N) :-
length(Os, N3),
N is N1 + N2 + N3.
fd_get(X, Dom, Ps) :-
( get_attr(X, clpfdId Attr) -> Attr = clpfd_attr(_,_,_,Dom,Ps)
( get_attr(X, clpfdId, Attr) -> Attr = clpfd_attr(_,_,_,Dom,Ps)
; var(X) -> default_domain(Dom), Ps = fd_props([],[],[])
).
fd_get(X, Dom, Inf, Sup, Ps) :-
fd_get(X, Dom, Ps),
domain_infimum(Dom, Inf),
......
......@@ -59,7 +59,7 @@
(define (write-module fpl fscm path)
(define (m p)
(let ((rev (reverse path)))
(reverse (cons (symbol-append (car rev) '.pl.scm) (cdr rev)))))
(reverse (cons (symbol-append (car rev) '.pl) (cdr rev)))))
(define module-data-opdata
(with-input-from-file fpl
(lambda ()
......@@ -122,6 +122,7 @@
(format #t "
(define-module ~a
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log guile-prolog attribute)
#:replace ~a)
" (m path) (map hh (cdr r)))))
......@@ -294,7 +295,7 @@
(define (ch x)
(let ((rev (reverse x)))
(reverse (cons (symbol-append (car rev) '.pl.scm) (cdr rev)))))
(reverse (cons (symbol-append (car rev) '.pl) (cdr rev)))))
(define (split-it str)
(map string->symbol (string-split str #\/)))
......@@ -357,7 +358,7 @@
(define (find-path f)
(let ((fpl (mk-file f ".pl"))
(fscm (mk-file f ".pl.scm")))
(fscm (mk-file f ".pl")))
(let lp ((l %load-path))
(if (pair? l)
(let ((str-scm (string-join
......@@ -371,7 +372,7 @@
(define (search-prolog-source f)
(let ((fpl (mk-file f ".pl"))
(fscm (mk-file f ".pl.scm")))
(fscm (mk-file f ".pl")))
(let lp ((l %load-path))
(if (pair? l)
(let ((str-pl (string-join
......@@ -467,15 +468,19 @@
(f l #f))))
(with-syntax ((f2 (datum->syntax stx pth))
(ff (datum->syntax stx h)))
(set-module! nm (resolve-module pth))
(pre-compile-prolog-file h)
(with-fluids ((*ops* (fluid-ref *ops*))
(*current-stack* (fluid-ref *current-stack*))
(*current-language* (lookup-language 'scheme)))
(set-module! nm (resolve-module pth))
(pre-compile-prolog-file h))
#`(eval-when (compile load eval)
(with-fluids ((*ops* (fluid-ref *ops*))
(*current-stack* (fluid-ref *current-stack*))
(*current-language* (lookup-language 'scheme)))
(pre-compile-prolog-file 'ff)
(set-module! '#,(datum->syntax stx nm) (resolve-module 'f2)))
(use-modules f2)))))
(with-fluids ((*ops* (fluid-ref *ops*)))
(process-use_module '((f2))))))))
((name imports)
(let* ((g (-> name))
......@@ -487,18 +492,23 @@
(((_ _ "as" _) m n)
`((,(atom m) . ,(atom n))))
(x (atom x))))
(pre-compile-prolog-file h)
(set-module! nm (resolve-module g))
(with-fluids ((*ops* (fluid-ref *ops*))
(*current-stack* (fluid-ref *current-stack*))
(*current-language* (lookup-language 'scheme)))
(pre-compile-prolog-file h)
(set-module! nm (resolve-module g)))
#`(eval-when (compile load eval)
(with-fluids ((*current-language* (lookup-language 'scheme))
(*current-stack* (fluid-ref *current-stack*))
(*ops* (fluid-ref *ops*)))
(pre-compile-prolog-file '#,ff)
(set-module! '#,(datum->syntax stx nm) (resolve-module 'f))
(use-modules (#,f
#:select
#,(datum->syntax stx (map ff (imp l))))))))))))))
(set-module! '#,(datum->syntax stx nm) (resolve-module 'f)))
(with-fluids ((*ops* (fluid-ref *ops*)))
(process-use_module
'((#,f
#:select
#,(datum->syntax stx (map ff (imp l)))))))))))))))
(lp l)))
......
#!/bin/bash
guile -s "prolog.scm"
guile -s "/usr/bin/prolog.scm"
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