added a kanren based on guile-log

parent 3097f766
......@@ -127,8 +127,8 @@ and-interleave
(let-syntax ((s (make-variable-transformer
(lambda (x)
(syntax-case x (set!)
((set! _ v)
#'(g v))
((set! _ w)
#'(g w))
((_ a (... ...))
#'(ss a (... ...)))
(var
......
This diff is collapsed.
(export <next> <or> <and> <not> <bag-of> <cond> <if>
<with-guile-log> <eval>
<with-guile-log> <eval> <if-some>
<cc> <fail> <let> <let*> <var> </.> <ask> <ret> <when>
<define> <cut> <pp> <pp-dyn> <set-cut>
bag-of/3 set-of/3 <run> <recur> <letrec>
<lambda> <with-fail> <with-cut> <peek-fail>
<match> <=> <r=> <==> *r* <funcall>
<and!> <and!!> <succeeds>
<and!> <and!!> <succeds>
<format> <tail-code> <code> <ret> <return>
<def> <<define>> <with-fail> <dynwind> parse<>
let<> <or-i> <stall> <continue> <take>
<state-ref> <state-set!> <lv*> <clear>
<and-i> and-interleave interleave tr
<letg> <set!> define-guarded)
<letg> <set!> define-guarded *gp-var-tr*)
(re-export define-guile-log guile-log-macro? log-code-macro log-code-macro?)
......@@ -44,26 +44,30 @@
(parse<> (fi last fi c)
code))))))
(define *gp-var-tr* (make-fluid 'v))
(define (tr x)
(define a '())
(define n 0)
(let loop ((x x))
(match x
((x . l)
(cons (loop x) (loop l)))
((? gp-var? x)
(let* ((m (gp-var-number (gp-lookup x)))
(r (assoc m a)))
(if r
(cdr r)
(let ((k (string->symbol
(format #f "v~a" n))))
(set! a (cons (cons m k) a))
(set! n (+ n 1))
k))))
(else
x))))
(define tr
(case-lambda
((x) (tr (fluid-ref *gp-var-tr*) x))
((pre x)
(define a '())
(define n 0)
(let loop ((x (u-scm x)))
(match x
((x . l)
(cons (loop x) (loop l)))
((? gp-var? x)
(let* ((m (gp-var-number (gp-lookup x)))
(r (assoc m a)))
(if r
(cdr r)
(let ((k (string->symbol
(format #f "~a~a" pre n))))
(set! a (cons (cons m k) a))
(set! n (+ n 1))
k))))
(else
x))))))
(define-syntax <run>
(syntax-rules (*)
......@@ -264,7 +268,7 @@
;; this will try to make a success and if so reset the state and continue it's a
;; companion to <not>.
(define-guile-log <succeeds>
(define-guile-log <succeds>
(syntax-rules ()
((_ (cut fi pr cc) g)
(let* ((P (gp-newframe))
......@@ -297,6 +301,7 @@
(let (pp p)
(parse<> (cut fi p cc) (<and> code ...))))))
(define-guile-log <if>
(syntax-rules ()
((_ meta p a)
......@@ -307,6 +312,13 @@
(parse<> (cut w pr cc)
(<and> (<and!> pred) (<with-fail> p a)))))
((parse<> (cut fi p cc) b))))))
(define-guile-log <if-some>
(syntax-rules ()
((_ meta p a)
(<and> p a))
((_ meta p a b)
(parse<> meta (<or> (<and> p a) (<and> (<not> p) b))))))
(define-guile-log <cond>
......
This diff is collapsed.
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