chicken-users
[Top][All Lists]
Advanced

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

[Chicken-users] are standard bindings write protected?


From: Joerg F. Wittenberger
Subject: [Chicken-users] are standard bindings write protected?
Date: 22 Nov 2003 16:49:43 +0100
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2

Hi Felix,

this seems to be another thing I've to leave for you:

I used to hijack 'force' as you can see below.  I'm pretty sure that
what I'm doing is r5rs compliant, isn't it?  The very same code did
actually work with chicken a couple of month ago.

It appears to be actually worse than just that.  The code, compiled in
module A modifies the globals, code in the module B (depending on A),
uses it, but gets the original definition instead my modified one.

I also see some suspicious messages relating to other definitions I
wrote over.  Like here:

Warning: global variable `abort' is never used
Warning: global variable `signal' is never used
Warning: global variable `##sys#error' is never used

`force' is not among them, but it's also used within A, which should
be reason enpugh.

The interpreter in contrast uses the modified force, but then goes
into an endless loop within 'UnlockedWait below.  This seems a srfi-18
problem, isn't it?

Best regards

/Jörg

Here my example code:

;;** future

(define-record-type <future>
  (internal-make-future mutex condition has-result result)
  future?
  (mutex future-mutex)
  (condition future-condition)
  (has-result future-has-result future-has-result-set!)
  (result future-result future-result-set!))



(define (logerr . args)
  (apply format (current-error-port) args)
  (flush-output (current-error-port)))

(define (debug lbl x) (logerr " D ~a: ~s\n" lbl x) x)

(define (future-force f)
  (if (debug 'HasResult (future-has-result f))
      (future-result f)
      (begin
        (debug 'GotLock (mutex-lock! (future-mutex f)))
        (if (debug 'HasNow (future-has-result f))
            (begin
              (debug 'Unlocked (mutex-unlock! (future-mutex f)))
              (future-result f))
            (begin
              (debug 'UnlockedWait (mutex-unlock! (future-mutex f) 
(future-condition f)))
              (future-result f))))))

(define (make-future thunk name)
  (let ((f (internal-make-future (make-mutex)
                                 (make-condition-variable)
                                 #f 'invalid)))
    (thread-start!
     (make-thread
      (lambda ()
        (future-result-set! f (with-exception-guard identity thunk))
        (future-has-result-set! f #t)
        (condition-variable-broadcast! (future-condition f)))
      name))
    f))

(let ((native-force force))
  (set! force (lambda (obj)
                ((if (future? obj) future-force native-force) obj))))

(cdr (force (make-future (lambda () (cons 'foo 'bar)) "my name")))


-- 
The worst of harm may often result from the best of intentions.





reply via email to

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