removed repr.scm

parent 03b05e3f
......@@ -16,6 +16,7 @@ PSSOURCES = \
ice-9/set/set.scm \
ice-9/set/complement.scm \
ice-9/vset.scm \
logic/guile-log/scmspace.scm \
logic/guile-log/fstream.scm \
logic/guile-log/guile-log-pre.scm \
logic/guile-log/ck.scm \
......@@ -24,7 +25,6 @@ PSSOURCES = \
logic/guile-log/umatch.scm \
logic/guile-log/attributed.scm \
logic/guile-log/macros.scm \
logic/guile-log/repr.scm \
logic/guile-log/match.scm \
logic/guile-log/undovar.scm \
logic/guile-log/interleave.scm \
......@@ -135,8 +135,8 @@ PSSOURCES = \
language/prolog/modules/library/forward_chaining.pl \
language/prolog/modules/ex/att.pl \
language/prolog/modules/examples/cluster.pl \
language/prolog/modules/library/clpb.pl
# language/prolog/modules/library/clpfd.pl
language/prolog/modules/library/clpb.pl \
language/prolog/modules/library/clpfd.pl
# language/prolog/modules/library/apply_macros.pl
AM_MAKEINFOFLAGS=--force
......
......@@ -204,7 +204,7 @@ mkdyn([[X|L]],(make_dynamic(X),U)) :- mkdyn(L,U).
all((X : Y) :- Z) :- !,fail.
all((H :- X)) :- !,
assertz(H :- call(X)),
assertzf(H :- call(X)),
fail.
all((:- Head)) :- !,
......@@ -222,7 +222,7 @@ all(Head) :-
(
Head =.. [F|L] ->
(
assertz(Head)
assertzf(Head)
) ;
atom(Head) -> assertz(Head)
),
......
......@@ -754,7 +754,7 @@ add/run * vlist *
(l (get-li e))
(data (if l
(vector t (p a) (p f) (p c))
(vector t a f c))))
(vector t a f c))))
(vector (next-bitmap-tag t)
(dynlist-add d data)
(my-list-add ar data)
......@@ -883,7 +883,6 @@ add/run * vlist *
(define (compile-raw e)
(let* ((l (get-dyn e))
(m (fold-dynlist-lr (lambda (x seed)
(expose x)
(max seed (get-t x)))
l 0))
(a (make-vector (+ 1 (first-set-bit m)))))
......
(define-module (logic guile-log iso-prolog)
#:use-module (logic guile-log scmspace)
#:use-module (logic guile-log prolog symbols)
#:use-module (logic guile-log hash-dynamic)
#:use-module (logic guile-log prolog base)
......@@ -38,7 +39,12 @@
#:export (reset-flags reset-prolog set)
#:replace (sort load)
#:re-export (;;swi stuff
#:re-export (;;guile stuff
;; profile
lambda define
use-modules
;;swi stuff
meta_predicate public
memberchk $skip_list is_list
keysort compare ground assertion
......@@ -358,3 +364,5 @@ sort(X,L) :- msort(X,LL),unique(LL,L).
(hashq-set! original f #f))
#t)))
(export-scm)
......@@ -12,6 +12,16 @@
(define-syntax-rule (aif (it) p a b) (let ((it p)) (if it a b)))
(define (repr s stx x)
(define (mks x) (datum->syntax stx (procedure-name x)))
(let ((x (gp-lookup x s)))
(cond
((procedure? x)
(mks x))
((null? x)
#`(quote #,x))
(else x))))
(define taglist (reverse (gp-get-taglist)))
(define pp #f)
(define* (tr x #:optional (m #f))
......@@ -291,9 +301,10 @@
table)
temp)
(define (pu x) (pretty-print (syntax->datum x)) x)
(define (rep comp)
#`(vector #,@(map (lambda (co) #``#,(repr s source? co))
(vector->list comp))))
#`((@ (guile) vector) #,@(pu (map (lambda (co) (repr s source? co))
(vector->list comp)))))
;(set! pp #t)
;(pretty-print `(compiled ,(compile-match source? s pat code)))
......
......@@ -83,7 +83,7 @@
(if (procedure? x)
(let ((n (procedure-name x))
(mod (procedure-property x 'module)))
(if (or #t (not mod))
(if (or (not mod))
(hashq-set! fkns x (gensym "FKN"))))
(hashq-set! fkns x (gensym "FKN"))))))
......
......@@ -490,4 +490,4 @@
(_
(type_error predicate_indicator X))))
(set! (@@ (logic guile-log prolog parser) assertz-source+) assertz-source)
(set! (@@ (logic guile-log prolog parser) assertz-source+) assertz-source+)
(define-module (logic guile-log repr)
#:use-module (logic guile-log umatch)
#:export (repr))
(define-syntax-rule (aif (r) p a b) (let ((r p)) (if r a b)))
(define (repr s stx x)
(define map (make-hash-table))
(define (mks x) (datum->syntax stx (procedure-name x)))
(define (mkvar) (datum->syntax stx (gensym "var")))
(define-syntax-rule (check (x y) code ...)
(let ((y #f))
(aif (r) (hashq-ref map x #f)
(if (eq? r #t)
(let ((r (mkvar)))
(hashq-set! map x r)
#`,#,r)
#`,#,r)
(begin
(hashq-set! map x #t)
(begin code ...)
(let ((r (hashq-ref map x #f)))
(if (eq? r #t)
(begin
(hashq-set! map x #f)
y)
#`(let* ((#,r (make-variable #f))
(res `#,y))
(variable-set #,r res))))))))
(let lp ((x x))
(let ((x (gp-lookup x s)))
(umatch (#:mode - #:name repr #:status s) (x)
((a . b)
(check (x y)
(let ((aa (lp a))
(bb (lp b)))
(set! y (cons aa bb)))))
(#(a)
(if (symbol? a)
#`#,x
(check (x y)
(let ((aa (lp a)))
(set! y #`,(vector `#,aa))))))
(#(a b)
(if (symbol? a)
#`#,x
(check (x y)
(let ((aa (lp a))
(bb (lp b)))
(set! y #`,(vector `#,aa `#,bb))))))
(_
(cond
((vector? x)
(if (eq? (vector-ref x 0) 'syntax-object)
#`,#,x
#`,(vector #,@(map (lambda (x) #``#,x)
(lp (vector->list x))))))
((symbol? x) (pk x))
((procedure? x)
#`,#,(mks x))
(else x)))))))
(define-module (logic guile-log scmspace)
#:export (export-scm))
(define (export-scm)
(let ((l '())
(m (current-module)))
(module-for-each (lambda (n v)
(let ((s (symbol-append 'scm- n)))
(module-add! m s v #;(variable-ref v))
(set! l (cons s l))))
(resolve-module '(guile)))
(module-export! m l)))
(define-module (prolog-user)
#:pure
#:autoload (system base compile) (compile compile-file)
#|#:use-module ((guile) #:renamer
(lambda (x)
(if (or ((@ (guile) eq?) x '@)
((@ (guile) eq?) x '@@)
((@ (guile) eq?) x 'quote))
x
((@ (guile) symbol-append) 'scm- x))))|#
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog ops)
......
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