guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Some fun with dynamic wind


From: Stefan Israelsson Tampe
Subject: Some fun with dynamic wind
Date: Tue, 1 Jan 2013 23:40:19 +0100

Hi all, I was trying to explore one of the features in guile-log and factor it out so that it works on the 
function stack in stead of the prolog stack essentially using the dynamic-wind feature, a schematic code is below
and to understand the code please read the post at 

      http://www.advogato.org/recentlog.html?thresh=3
      see post by Tampe

The intention is to solve the problem with set! - ing variables and trying the store the state via continuations

The idea is to introduce a new binding construct e.g.

(letg ((x v)) .... (set! x (cons a x)) ...)

The problem with storing the state, save a continuation, then restart and do the set! above, the value of
x will also be changed in the old continuation and hence the state will have been mutated and by redoing it,
the old state cannot be restored. The nice thing with letg variables is that when we abort or reinstate
a state, one can choose to store the old state of the variable or the current state. This is actually quite a feature
to have in prolog, and it's really useful there. I do not know if the corresponding feature is that nice in scheme though.

Anyway in the scheme code below there is a construct e.g.

(with-guarded-state gset! ((x '(2)))   ... (gset! (lambda () continuation-of-logic-here) (cons 1 (car x))))


To note here is that the gset! function will, for the rest of the logic be setted to "(cons 1 x)". If we then later
do a special abort (see below) and store the state we will maintain that variable across the abort. we instead
choose to abort with another abort e.g. wind-ref == #f, we would then restore the old value.

Similar techniques could be used if to select what semantics one would like to have when reinstating an
old continuation e.g., keep the variable values or restore the old state completely.

A simple extension to the logic could be to add a level to the letg variable. e.g. one could keep all variables,
with levels < > etc  a specific number, constant and the rest instated with the old value.

Anyway the transformed code below needs things to use CPS style of technique of coding and can be a bit heavy
to use. I'm not certain if there is a value apart from coding prolog like features from which the code derives. Also
to connect to my previous mail, for this to be an effective and useful technique, one must change tail call dynwinds
like the tail dynlet sematic in the VM.

Happy Hacking!

/Stefan



(define hooks (make-fluid #f))
(define (push-hook f)
  (let ((h (fluid-ref hooks)))
    (if h
        (fluid-set! hooks (cons f h))
        (fluid-set! hooks (list f)))))

(define (do-memo-hooks cc)
  (let ((hs (fluid-ref hooks)))
    (if hs
        (let loop ((hs hs))
          (if (pair? hs)
              ((car hs) (lambda () (loop (cdr hs))))
              (begin (fluid-set! hooks #f) (cc))))
        (cc))))
        
(define (my-set! s ss) 
  (for-each (lambda (s ss) (set-car! s) (car ss))
            s ss))

(define (copy s) (map (lambda (x) (list (car x))) s))

(define (mk-guard fr done guard . s)
  (lambda (cc . ss)
    (let ((so (copy s)))
      (my-set! s ss)
      (dynamic-wind
        (lambda ()
          (when (and (fluid-ref wind-ref) (not done))
            (begin
              (set-car! done #t)
              (push-hook
               (let ((ss (copy s)))
                 (lambda (cc)
                   (set-car! done #f)
                   (when (not (andmap eq? s ss))
                     (if (car fr)
                         (apply guard cc ss)
                         (begin (my-set! s ss) (cc)))))))))
          (my-set! s ss))

        cc

        (lambda ()
          (when (and (fluid-ref wind-ref) (not done))
            (begin
              (set-car! done #t)
              (push-hook
               (let ((ss (copy s)))
                 (lambda (cc)
                   (set-car! done #f)
                   (when (not (andmap eq? s ss))
                     (if (car fr)
                         (apply guard cc ss)
                         (my-set! s ss))))))))
          (my-set! s so))))))

(define-syntax with-guarded-states
  (lambda (x)
    (syntax-case x ()
      ((_ guard ((s v) ...) code ...)
       #'(let ((s (list v)) ... (fr (list #t)) (done (list #f)))
           (letrec ((guard  (mk-guard fr done guard s ...)))
             (dynamic-wind
               (lambda ()
                 (set-car! fr   #t)
                 (set-car! done #t)
                 (push-hook
                  *current-stack*
                  (lambda ()
                    (set-car! done #f))))
               (lambda () code ...)                   
               (lambda (x) (set-car! fr #f)))))))))


(define (abort-to-prompt-memo tag cc . val)
  (apply abort-to-prompt tag val)
  (do-memo-hooks cc))

    

reply via email to

[Prev in Thread] Current Thread [Next in Thread]