removed repr.scm

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