small fixes

parent 77656ef2
......@@ -116,6 +116,7 @@ PSSOURCES = \
logic/guile-log/guile-prolog/gc-call.scm \
logic/guile-log/guile-prolog/coroutine.scm \
logic/guile-log/guile-prolog/attributator.scm \
logic/guile-log/guile-prolog/optimize.scm \
logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \
prolog-user.scm
......
......@@ -89,7 +89,11 @@ add/run * vlist *
===========================
|#
(define (pp . x) (pretty-print (syntax->datum x)) (car (reverse x)))
(define do-print #f)
(define (pp . x)
(if do-print
(pretty-print (syntax->datum x)))
(car (reverse x)))
(define (ppp a x) (pretty-print (list a (syntax->datum x))) x)
(define (make-indexer) (vector #f #f 0 #f 0 vlist-null vlist-null))
......@@ -1783,7 +1787,7 @@ add/run * vlist *
(let lp ((x x))
(syntax-case x (unquote quote)
(#(((unquote x) a b))
(let ((xx (pk (syntax->datum #'x))))
(let ((xx (syntax->datum #'x)))
(let ((res (and (symbol? xx)
(assoc xx (fluid-ref special-translators)))))
(if res
......@@ -1874,9 +1878,9 @@ add/run * vlist *
(lambda (x)
(syntax-case x ()
((_ (pat ...) code)
(with-syntax (((pat2 ...) (ppp 'a (parse-pat-extended2 #'(pat ...)))))
(with-syntax (((pat2 ...) (pp 'a (parse-pat-extended2 #'(pat ...)))))
(pp #`(list (lambda ()
#,(ppp 'b (mk-varpat-extended2 #'(pat ...))))
#,(pp 'b (mk-varpat-extended2 #'(pat ...))))
(lambda ()
(lambda (a b c cut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut code)))
......
(define-module (logic guile-log guile-prolog optimize)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog ops)
#:export (compilable_scm))
(compile-prolog-string
"
-extended.
compilable_scm((+ ; - ; * ; /)(X,Y)) :- !,
compilable_scm(X),
compilable_scm(Y).
compilable_scm((+ ; -)(X)) :- !,
compilable_scm(X).
compileable_scm(X) :- atomic(X).
")
#|
(compile-prolog-string "
-extended.
copmilable_op((< ; =< ; >= ; > ; == ; =\\= ; ',')(X,Y)) :-
compilable_scm(X),
compilable_scm(Y).
compilable_op(X is Y) :-
compilable_scm(Y).
compilable_ops(X = Y).
copmilable_op(\\+ X) :-
compilable_op(X).
-extended(;,and,',',or)
all_comma((and(Op,or())(X,Y),[[Op,L1,L2]]) :-
all_comma(X,L1),
all_comma(Y,L2).
all_comma(\\+ X,[[\+,L]]) :-
all_comma(X,L).
all_comma((X,Y),L) :-
all_comma(X,L1),
all_comma(Y,L2),
append(L1,L2,L).
all_comma(X,[X]).
combine_comma([X|Y],U,CL) :-
compilable_op(X) ->
(
[X|L]=U,
combine_comma(Y,L,CL)
) ;
U=[X],
CL=[C|CL2],
Y=[_|_] ->
combine_comma(Y,C,CL2);
Y=[],CL=[].
combine_comma([],[],[]).
compile_expr([X|Y],L,H) :-
compile_expr(X,L1,H),
compile_expr(X,L2,H),
append(L1,L2,L).
")
|#
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