Special variables to relax boxing

Special variables to relax boxing

[Stefan Israelsson Tampe]

[-- Attachment #1: Type: text/plain, Size: 714 bytes --]

Hi,

I wouldl like to start a discussion of introducing a way to mark
variables as special, and by that mean that set! variables does not
nessesary get boxed. This is a deviation from the scheme standard but
it's pretty useful if one want to set! local variables but make sure
that the state of the function can be stored in a continuation and
later restart at the same state.

This patch introduces a macro (mark-as-special var), this will mark
var as a special variable in the above meaning, please look at the
example in special.scm for more info.

There is a preleminary patch following the document against stable-2.0
that we can use as a discussion point for know about this feature.

Best Greetings
Stefan


[-- Attachment #2: special.scm --]
[-- Type: text/x-scheme, Size: 3908 bytes --]

(use-modules (system vm special-variable))
;; This makes sure to treat s special and not box it
(define (g x) 
  (let ((s 0)) 
    (mark-as-special s)  
    (let lp ((i 0)) 
      (if (< i 10000000) 
	  (begin (set! s (+ i s)) 
		 (lp (+ i 1))) 
	  s))))

#|
,x g

0    (assert-nargs-ee/locals 17)     ;; 1 arg, 2 locals
   2    (make-int8:0)                   ;; 0
   3    (local-set 1)                   ;; `s'
   5    (new-frame)                     
   6    (toplevel-ref 1)                ;; `((system vm special-variable) special #f)'
   8    (local-ref 1)                   ;; `s'
  10    (mv-call 1 :L583)               ;; MV -> 20
  15    (drop)                          
  16    (br :L584)                      ;; -> 23
  20    (truncate-values 0 0)           
  23    (br :L585)                      ;; -> 56
  27    (local-ref 2)                   ;; `i'
  29    (make-int16 3 232)              ;; 1000
  32    (lt?)                           
  33    (br-if-not :L586)               ;; -> 53
  37    (local-ref 2)                   ;; `i'
  39    (local-ref 1)                   ;; `s'
  41    (add)                           
  42    (local-set 1)                   ;; `s'
  44    (local-ref 2)                   ;; `i'
  46    (add1)                          
  47    (local-set 2)                   ;; `i'
  49    (br :L587)                      ;; -> 27
  53    (local-ref 1)                   ;; `s'
  55    (return)                        
  56    (make-int8:0)                   ;; 0
  57    (local-set 2)                   
  59    (br :L587)                      ;; -> 27

|#
;; This makes sure to treat s as special but we cannot box it because it's 
;; referenced in closure, set! + closure  = boxed
(define (g2 x) 
  (let ((s 0)) 
    (mark-as-special s)  
    (let lp ((i 0)) 
      (if (< i 10000000) 
	  (begin (set! s (+ i s)) 
		 (lp (+ i 1))) 
	  (lambda () s)))))


#|
0    (assert-nargs-ee/locals 17)     ;; 1 arg, 2 locals
   2    (make-int8:0)                   ;; 0                  at /home/stis/src/special.scm:45:2
   3    (box 1)                         
   5    (new-frame)                                           at /home/stis/src/special.scm:46:4
   6    (toplevel-ref 1)                ;; `((system vm special-variable) special #f)'
   8    (local-boxed-ref 1)             ;; `s'
  10    (mv-call 1 :L824)               ;; MV -> 20
  15    (drop)                          
  16    (br :L825)                      ;; -> 23
  20    (truncate-values 0 0)           
  23    (br :L826)                      ;; -> 67              at /home/stis/src/special.scm:47:4
  27    (local-ref 2)                   ;; `i'
  29    (make-uint64 0 0 0 0 0 152 150 128);; 10000000
  38    (lt?)                                                 at /home/stis/src/special.scm:48:10
  39    (br-if-not :L827)               ;; -> 59              at /home/stis/src/special.scm:48:6
  43    (local-ref 2)                   ;; `i'
  45    (local-boxed-ref 1)             ;; `s'
  47    (add)                                                 at /home/stis/src/special.scm:49:25
  48    (local-boxed-set 1)             ;; `s'                at /home/stis/src/special.scm:49:17
  50    (local-ref 2)                   ;; `i'
  52    (add1)                                                at /home/stis/src/special.scm:50:21
  53    (local-set 2)                   ;; `i'
  55    (br :L828)                      ;; -> 27              at /home/stis/src/special.scm:50:17
  59    (object-ref 2)                  ;; #<procedure 13bbe80 at /home/stis/src/special.scm:51:10 ()>
  61    (local-ref 1)                   ;; `s'
  63    (make-closure 0 1)              
  66    (return)                                              at /home/stis/src/special.scm:47:4
  67    (make-int8:0)                   ;; 0
  68    (local-set 2)                   
  70    (br :L828)                      ;; -> 27
|#

[-- Attachment #3: special.diff --]
[-- Type: text/x-patch, Size: 10680 bytes --]

diff --git a/module/Makefile.am b/module/Makefile.am
index c47d0b4..b07c342 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -101,6 +101,7 @@ SCHEME_LANG_SOURCES =						\
   language/scheme/decompile-tree-il.scm
 
 TREE_IL_LANG_SOURCES =						\
+  language/tree-il/special.scm					\
   language/tree-il/primitives.scm				\
   language/tree-il/effects.scm                                 	\
   language/tree-il/fix-letrec.scm                               \
@@ -337,6 +338,7 @@ OOP_SOURCES = \
   oop/goops/simple.scm
 
 SYSTEM_SOURCES =				\
+  system/vm/special-variable.scm                \
   system/vm/inspect.scm				\
   system/vm/coverage.scm			\
   system/vm/frame.scm				\
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index badce9f..50d64b8 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -151,7 +151,7 @@
     (hashq-set! res k v)
     res))
 
-(define (analyze-lexicals x)
+(define* (analyze-lexicals x #:optional (special-vars #f))
   ;; bound-vars: lambda -> (sym ...)
   ;;  all identifiers bound within a lambda
   (define bound-vars (make-hash-table))
@@ -159,6 +159,9 @@
   ;;  all identifiers referenced in a lambda, but not bound
   ;;  NB, this includes identifiers referenced by contained lambdas
   (define free-vars (make-hash-table))
+  ;; free-syms: sym -> #t
+  ;;   All variables that is free with respect to a lambda.
+  (define free-syms (make-hash-table))
   ;; assigned: sym -> #t
   ;;  variables that are assigned
   (define assigned (make-hash-table))
@@ -180,7 +183,7 @@
       (analyze! x new-proc (append labels labels-in-proc) #t #f))
     (define (recur x new-proc) (analyze! x new-proc '() tail? #f))
     (record-case x
-      ((<application> proc args)
+      ((<application> proc args)                              
        (apply lset-union eq? (step-tail-call proc args)
               (map step args)))
 
@@ -236,6 +239,9 @@
        (let ((free (recur body x)))
          (hashq-set! bound-vars x (reverse! (hashq-ref bound-vars x)))
          (hashq-set! free-vars x free)
+         (for-each (lambda (var)
+                     (hashq-set! free-syms var #t))
+                   free)
          free))
       
       ((<lambda-case> opt kw inits gensyms body alternate)
@@ -286,7 +292,8 @@
                      ;; recur/labels instead of recur
                      (hashq-set! bound-vars x '())
                      (let ((free (recur/labels body x gensyms)))
-                       (hashq-set! bound-vars x (reverse! (hashq-ref bound-vars x)))
+                       (hashq-set! bound-vars x 
+                                   (reverse! (hashq-ref bound-vars x)))
                        (hashq-set! free-vars x free)
                        free))))
                 vals))
@@ -330,7 +337,11 @@
                               (append (hashq-ref bound-vars val)
                                       (hashq-ref bound-vars proc)))
                   (hashq-remove! bound-vars val)
-                  (hashq-remove! free-vars val))))
+                  (hashq-remove! free-vars val))
+                ;; Else we will allocate a closure; register the free-syms
+                (for-each (lambda (sym)
+                            (hashq-set! free-syms sym #t))
+                          (hashq-ref free-vars val))))
           gensyms vals)
          (lset-difference eq?
                           (apply lset-union eq? body-refs var-refs)
@@ -395,7 +406,12 @@
              (begin
                (hashq-set! (hashq-ref allocation (car c))
                            x
-                           `(#f ,(hashq-ref assigned (car c)) . ,n))
+                           `(#f ,(and (hashq-ref assigned (car c))
+                                      (not (and special-vars
+                                                (hashq-ref special-vars (car c))
+                                                (not (hashq-ref free-syms 
+                                                                (car c))))))
+                                . ,n))
                (lp (cdr c) (1+ n)))))
       
        (let ((nlocs (allocate! body x 0))
@@ -427,7 +443,15 @@
               (begin
                 (hashq-set! allocation (car gensyms)
                             (make-hashq
-                             proc `(#t ,(hashq-ref assigned (car gensyms)) . ,n)))
+                             proc `(#t 
+                                    ,(and (hashq-ref assigned (car gensyms))
+                                          (not (and special-vars
+                                                    (hashq-ref special-vars 
+                                                               (car gensyms))
+                                                    (not (hashq-ref 
+                                                          free-syms 
+                                                          (car gensyms))))))
+                                       . ,n)))
                 (lp (cdr gensyms) (1+ n)))))
         (if alternate (allocate! alternate proc n) n)))
       
@@ -456,7 +480,12 @@
                    (hashq-set!
                     allocation v
                     (make-hashq proc
-                                `(#t ,(hashq-ref assigned v) . ,n)))
+                                `(#t ,(and (hashq-ref assigned v)
+                                      (not (and special-vars
+                                                (hashq-ref special-vars v)
+                                                (not (hashq-ref free-syms 
+                                                                v)))))
+                                     . ,n)))
                    (lp (cdr gensyms) (1+ n)))))))))
       
       ((<letrec> gensyms vals body)
@@ -471,7 +500,12 @@
                (hashq-set!
                 allocation v
                 (make-hashq proc
-                            `(#t ,(hashq-ref assigned v) . ,n)))
+                            `(#t ,(and (hashq-ref assigned v)
+                                      (not (and special-vars
+                                                (hashq-ref special-vars v)
+                                                (not (hashq-ref free-syms 
+                                                                v)))))
+                                 . ,n)))
                (lp (cdr gensyms) (1+ n))))))
 
       ((<fix> gensyms vals body)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index e4df6e1..7321fb1 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -29,6 +29,7 @@
   #:use-module (language tree-il optimize)
   #:use-module (language tree-il canonicalize)
   #:use-module (language tree-il analyze)
+  #:use-module (language tree-il special)
   #:use-module ((srfi srfi-1) #:select (filter-map))
   #:export (compile-glil))
 
@@ -64,9 +65,10 @@
 
   (let* ((x (make-lambda (tree-il-src x) '()
                          (make-lambda-case #f '() #f #f #f '() '() x #f)))
-         (x (optimize! x e opts))
+         (x (optimize! (optimize! x e opts) e opts))
          (x (canonicalize! x))
-         (allocation (analyze-lexicals x)))
+         (special-vars (register-special-vars x))
+         (allocation (analyze-lexicals x special-vars)))
 
     (with-fluids ((*comp-module* e))
       (values (flatten-lambda x #f allocation)
diff --git a/module/language/tree-il/special.scm b/module/language/tree-il/special.scm
new file mode 100644
index 0000000..0e38084
--- /dev/null
+++ b/module/language/tree-il/special.scm
@@ -0,0 +1,104 @@
+(define-module (language tree-il special)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
+  #:use-module (system base syntax)
+  #:use-module (system base message)
+  #:use-module (system vm program)
+  #:use-module (language tree-il)
+  #:use-module (system base pmatch)
+  #:export (register-special-vars))
+
+
+(define (register-special-vars x)
+  (define register (make-hash-table))
+  (let lp ((x x))
+    (record-case x
+      ((<application> proc args)                              
+       (record-case proc
+         ((<module-ref> src mod name public?)
+          (if (and (equal? mod '(system vm special-variable))
+                   (eq?    name 'special)
+                   (= (length args) 1))
+              (record-case (car args)
+                ((<lexical-ref> src gensym)
+                 (hashq-set! register gensym #t))
+                (else #t))))
+         (else #f))
+       (lp proc)
+       (for-each lp args))
+
+      ((<conditional> test consequent alternate)
+       (lp test)
+       (lp consequent)
+       (lp alternate))
+
+          
+      ((<lexical-set> gensym exp)
+       (lp exp))
+
+      ((<module-set> exp)
+       (lp exp))
+      
+      ((<toplevel-set> exp)
+       (lp exp))
+      
+      ((<toplevel-define> exp)
+       (lp exp))
+      
+      ((<sequence> exps)
+       (for-each lp exps))
+
+      ((<lambda> body)
+       (lp body))
+      
+      ((<lambda-case> opt kw inits gensyms body alternate)
+       (for-each lp inits)
+       (lp body)
+       (if alternate (lp alternate)))
+      
+      ((<let> gensyms vals body)
+       (for-each lp vals)
+       (lp body))
+
+      ((<letrec> gensyms vals body)
+       (for-each lp vals)
+       (lp body))
+      
+      ((<fix> gensyms vals body)
+       (for-each lp vals)
+       (lp body))
+
+      ((<let-values> exp body)
+       (lp exp)
+       (lp body))
+      
+      ((<dynwind> body winder unwinder)
+       (lp body)
+       (lp winder)
+       (lp unwinder))
+      
+      ((<dynlet> fluids vals body)
+       (lp body)
+       (for-each lp (append fluids vals)))
+          
+      ((<dynref> fluid)
+       (lp fluid))
+      
+      ((<dynset> fluid exp)
+       (lp fluid) (lp exp))
+      
+      ((<prompt> tag body handler)
+       (lp tag) 
+       (lp body) 
+       (lp handler))
+      
+      ((<abort> tag args tail)
+       (lp tag) (lp tail) (for-each lp args))
+      
+      (else #t)))
+  register)
+
diff --git a/module/system/vm/special-variable.scm b/module/system/vm/special-variable.scm
new file mode 100644
index 0000000..2068b84
--- /dev/null
+++ b/module/system/vm/special-variable.scm
@@ -0,0 +1,9 @@
+(define-module (system vm special-variable)
+  #:export (mark-as-special))
+
+(define special (lambda (x) #f))
+
+(define-syntax-rule (mark-as-special v ...)
+  (begin
+    (special v)
+    ...))

Re: Special variables to relax boxing

[Mark H Weaver]

Hi Stefan,

Stefan Israelsson Tampe <stefan.itampe@gmail.com> writes:
> I wouldl like to start a discussion of introducing a way to mark
> variables as special, and by that mean that set! variables does not
> nessesary get boxed.

I don't think you fully understand the ramifications of what you're
proposing here.  In the general case, mutable variables need to be boxed
because closures end up with copies of any free variables that they
reference.  If a free variable is mutable, that means it needs a copy of
the _location_ where the value is stored.  Making a copy of the _value_
of a variable at the time of closure creation would lead to very
unintuitive (and IMO broken) behavior.

More importantly, you are describing this proposed language feature in
terms of low-level implementation details.  If you're serious about
proposing such a fundamental new feature to Scheme, please start by
reading and understanding the denotational semantics of the R5RS,
especially sections 3.1 and 3.4, and then reformulate your proposal in
those terms.  For such a fundamental change, I'd want to see a proposed
new formal denotational semantics to replace those in section 7.2.

To be honest, I'm not suggesting this to help you refine this proposal.
I'm suggesting it because I think it would help you to think more
clearly about these issues, and to appreciate the beautiful elegance of
Scheme's minimalist semantics.  Furthermore, I hope it would help you to
understand what a terrible mistake it would be to muck such a beautiful
language with hacks such as this.  Every added bit of complexity in the
core of a language has to be paid for a hundred times over, in both code
(compilers, optimizers, etc) and more importantly in the mental effort
required to reason about the language.

       Mark

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

Ok, This was a first step to get what I would like to have implemented
in the tree il backend (Not for scheme but perhaps something useful
for e.g. emacs-lisp, python etc).

My main issue with the current setup is that adding undoing and
redoing feature with the help of prompts will fail in 95% of the cases
where the program is written in an imperative style which is not
uncommmon in languages we would like to support in guile. Prompts is
such a cool feature and is probably one of the main selling points of
why one should use their language ontop of guile. So I've just
exploring how to improve on this.

I think you missundeerstood my posted semantic. It will box if you
set! a variable and the same variable is located in a closure, I think
that is a safe approach. But you are right that it's a very unclear
semantic but my intention was to use this as a step of a better
primitive.

So over to the semantic I would like to have, To do it currently in
guile you would need to do
something like,
(define-syntax with-guarded-var
  (lambda (x)
     (syntax-case x ()
        ((_ var code)
         (with-syntax ((guard ...))
            #'(let ((guard (make-fluid)))
                 (with-fluids ((guard var))
                    (dynamic-wind
                        (lambda () (set! var (fluid-ref guard))
                        (lambda () (mark-as-special var) code)
                        (lambda x (fluid-set! guard var)))))))))))

It might be improved but is really really a horrendous solution to the
semantic. The semantic is pretty close to a fluid variable solution
but it will mix much better with delayed computations and is a big
reason for not using fluids in a more simple try. What I would like to
propose is an idiom in tree-il that basicly looks like

(with-special (var ...) code ...)

and what it does is to put onto the stack is the following
----------------------------
mark
var1
place1
var2
place2
...
mark-end
-----------------------------
and then execute the code just as nothing have happend.

Then we could add the code to the stack copying part of the prompt cal/cc etc to
when scanning the stack backwards, if it sees maek-end, then it will
store the value
of var1 in place 1 etc. And when reinstalling the stack it will search
for the mark and
place the value of place1 into the var in var1 and so on.


Another solution is to add a new control ideom onto the control stack
where the fluid controls and dynamic wind control lives with a pointer
ti the var1 position and the number of vars. With this solution we can
skip the marks and also improve the performance of the installment and
savings of the stack, the drawback is that we neede to handle that we
install the saved stack perhaps at another adress, but it's doable. (A
good thing using this is that we can reuse this rebasing technique to
improve the speed and scaleup of fluid variables at a tail call
position in many cases)

I actually use a clumsy version of this semantic in guile-log and I
know that although it is anesoteric feature it means that you can
easilly implement really cool features that I would not dare to write
in e.g. kanren, If you write a prompt based logic implementation It
will make a hughe difference in what you have the above semantic
without going down to snail speed.

To increase speed further the system would use (mark-as-special) and
check if it can be unboxed, in which case tha variable will not be
baxed and with-special will be a no op.

I hope that this is a clearer description of what I'm aiming at!

/Stefan







On Thu, Mar 21, 2013 at 7:00 AM, Mark H Weaver <mhw@netris.org> wrote:
> Hi Stefan,
>
> Stefan Israelsson Tampe <stefan.itampe@gmail.com> writes:
>> I wouldl like to start a discussion of introducing a way to mark
>> variables as special, and by that mean that set! variables does not
>> nessesary get boxed.
>
> I don't think you fully understand the ramifications of what you're
> proposing here.  In the general case, mutable variables need to be boxed
> because closures end up with copies of any free variables that they
> reference.  If a free variable is mutable, that means it needs a copy of
> the _location_ where the value is stored.  Making a copy of the _value_
> of a variable at the time of closure creation would lead to very
> unintuitive (and IMO broken) behavior.
>
> More importantly, you are describing this proposed language feature in
> terms of low-level implementation details.  If you're serious about
> proposing such a fundamental new feature to Scheme, please start by
> reading and understanding the denotational semantics of the R5RS,
> especially sections 3.1 and 3.4, and then reformulate your proposal in
> those terms.  For such a fundamental change, I'd want to see a proposed
> new formal denotational semantics to replace those in section 7.2.
>
> To be honest, I'm not suggesting this to help you refine this proposal.
> I'm suggesting it because I think it would help you to think more
> clearly about these issues, and to appreciate the beautiful elegance of
> Scheme's minimalist semantics.  Furthermore, I hope it would help you to
> understand what a terrible mistake it would be to muck such a beautiful
> language with hacks such as this.  Every added bit of complexity in the
> core of a language has to be paid for a hundred times over, in both code
> (compilers, optimizers, etc) and more importantly in the mental effort
> required to reason about the language.
>
>        Mark

Re: Special variables to relax boxing

[Noah Lavine]

[-- Attachment #1: Type: text/plain, Size: 7358 bytes --]

Hello,

I think I understand what Stefan wants here, and I think it should probably
be possible.

If I understand correctly, the issue is that when a continuation is
captured, it stores the *locations* of all of the variables in-scope at
that point. If that continuation is invoked many times, each invocation
will continue to refer to the same locations. What Stefan wants is a way to
capture a continuation-like object that includes the *values* of all of the
mutable variables that were in scope, so that when it restarts (even
multiple times) the values will always start at the same point.

To me, the strongest indicator that this should be possible is that if you
took the program with mutable variables and rewrote it by splitting each
function in two at each use of set! (as in continuation-passing style),
making the mutable variable simply an argument to each continuation, then
you would get this behavior with the current semantics. (I believe this is
also the same as rewriting everything to use monads to handle mutable
state.) Here's an example of what I mean. This function with mutable
variables:

(lambda ()
  (let ((x 5))
    (set! x (compute-1 x))
    (set! x (compute-2 x))
    x))

becomes

(lambda ()
  (let ((k1 (lambda (x) (k2 (compute-2 x))))
        (k2 (lambda (x) x)))
    (k1 (compute-1 x))))

However, this rewriting idea runs into trouble when you try to figure out
what happens to mutable variables that have been captured by closures (as
Mark said). I don't know what the right solution is here.

Noah


On Thu, Mar 21, 2013 at 5:35 AM, Stefan Israelsson Tampe <
stefan.itampe@gmail.com> wrote:

> Ok, This was a first step to get what I would like to have implemented
> in the tree il backend (Not for scheme but perhaps something useful
> for e.g. emacs-lisp, python etc).
>
> My main issue with the current setup is that adding undoing and
> redoing feature with the help of prompts will fail in 95% of the cases
> where the program is written in an imperative style which is not
> uncommmon in languages we would like to support in guile. Prompts is
> such a cool feature and is probably one of the main selling points of
> why one should use their language ontop of guile. So I've just
> exploring how to improve on this.
>
> I think you missundeerstood my posted semantic. It will box if you
> set! a variable and the same variable is located in a closure, I think
> that is a safe approach. But you are right that it's a very unclear
> semantic but my intention was to use this as a step of a better
> primitive.
>
> So over to the semantic I would like to have, To do it currently in
> guile you would need to do
> something like,
> (define-syntax with-guarded-var
>   (lambda (x)
>      (syntax-case x ()
>         ((_ var code)
>          (with-syntax ((guard ...))
>             #'(let ((guard (make-fluid)))
>                  (with-fluids ((guard var))
>                     (dynamic-wind
>                         (lambda () (set! var (fluid-ref guard))
>                         (lambda () (mark-as-special var) code)
>                         (lambda x (fluid-set! guard var)))))))))))
>
> It might be improved but is really really a horrendous solution to the
> semantic. The semantic is pretty close to a fluid variable solution
> but it will mix much better with delayed computations and is a big
> reason for not using fluids in a more simple try. What I would like to
> propose is an idiom in tree-il that basicly looks like
>
> (with-special (var ...) code ...)
>
> and what it does is to put onto the stack is the following
> ----------------------------
> mark
> var1
> place1
> var2
> place2
> ...
> mark-end
> -----------------------------
> and then execute the code just as nothing have happend.
>
> Then we could add the code to the stack copying part of the prompt cal/cc
> etc to
> when scanning the stack backwards, if it sees maek-end, then it will
> store the value
> of var1 in place 1 etc. And when reinstalling the stack it will search
> for the mark and
> place the value of place1 into the var in var1 and so on.
>
>
> Another solution is to add a new control ideom onto the control stack
> where the fluid controls and dynamic wind control lives with a pointer
> ti the var1 position and the number of vars. With this solution we can
> skip the marks and also improve the performance of the installment and
> savings of the stack, the drawback is that we neede to handle that we
> install the saved stack perhaps at another adress, but it's doable. (A
> good thing using this is that we can reuse this rebasing technique to
> improve the speed and scaleup of fluid variables at a tail call
> position in many cases)
>
> I actually use a clumsy version of this semantic in guile-log and I
> know that although it is anesoteric feature it means that you can
> easilly implement really cool features that I would not dare to write
> in e.g. kanren, If you write a prompt based logic implementation It
> will make a hughe difference in what you have the above semantic
> without going down to snail speed.
>
> To increase speed further the system would use (mark-as-special) and
> check if it can be unboxed, in which case tha variable will not be
> baxed and with-special will be a no op.
>
> I hope that this is a clearer description of what I'm aiming at!
>
> /Stefan
>
>
>
>
>
>
>
> On Thu, Mar 21, 2013 at 7:00 AM, Mark H Weaver <mhw@netris.org> wrote:
> > Hi Stefan,
> >
> > Stefan Israelsson Tampe <stefan.itampe@gmail.com> writes:
> >> I wouldl like to start a discussion of introducing a way to mark
> >> variables as special, and by that mean that set! variables does not
> >> nessesary get boxed.
> >
> > I don't think you fully understand the ramifications of what you're
> > proposing here.  In the general case, mutable variables need to be boxed
> > because closures end up with copies of any free variables that they
> > reference.  If a free variable is mutable, that means it needs a copy of
> > the _location_ where the value is stored.  Making a copy of the _value_
> > of a variable at the time of closure creation would lead to very
> > unintuitive (and IMO broken) behavior.
> >
> > More importantly, you are describing this proposed language feature in
> > terms of low-level implementation details.  If you're serious about
> > proposing such a fundamental new feature to Scheme, please start by
> > reading and understanding the denotational semantics of the R5RS,
> > especially sections 3.1 and 3.4, and then reformulate your proposal in
> > those terms.  For such a fundamental change, I'd want to see a proposed
> > new formal denotational semantics to replace those in section 7.2.
> >
> > To be honest, I'm not suggesting this to help you refine this proposal.
> > I'm suggesting it because I think it would help you to think more
> > clearly about these issues, and to appreciate the beautiful elegance of
> > Scheme's minimalist semantics.  Furthermore, I hope it would help you to
> > understand what a terrible mistake it would be to muck such a beautiful
> > language with hacks such as this.  Every added bit of complexity in the
> > core of a language has to be paid for a hundred times over, in both code
> > (compilers, optimizers, etc) and more importantly in the mental effort
> > required to reason about the language.
> >
> >        Mark
>
>

[-- Attachment #2: Type: text/html, Size: 8704 bytes --]

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

On Thursday, March 21, 2013 11:35:19 AM Noah Lavine wrote:
> (lambda ()
>   (let ((x 5))
>     (set! x (compute-1 x))
>     (set! x (compute-2 x))
>     x))
> 
> becomes
> 
> (lambda ()
>   (let ((k1 (lambda (x) (k2 (compute-2 x))))
>         (k2 (lambda (x) x)))
>     (k1 (compute-1 x))))
> 
> However, this rewriting idea runs into trouble when you try to figure
> out what happens to mutable variables that have been captured by
> closures (as Mark said). I don't know what the right solution is
> here.

The semantic is that cpatured variables in lambdas will be restored to
the value when the continuation left the guard. And this is something
you want many times e.g. consider,

(let ((a 0)
      (f (case-lambda (() a) ((b) (set! a b)))))
 (with-special (a)
   (for-each (lambda (x) (if (blah x) 
                             (k x f)
			     (abort-to-prompt 'tag a)))
      a-list)
   (f)))

Assume that you would like to be able to go back to the tag abort many
times in a redo/undo sequence, then it is natural for the a referenced
in f to be restored as well. But as you know sometimes this is not
what we want. As I said, using dynwinds and fluids it's really
possible to get this behavior today but it's really a bloated
solution. Anyhow the good news with this semantic is as with the
current behavior of assigned variables it's easy to reason with the
code although one risk some severe bugs. 

A good question though is
what we should use as default for e.g. a python implementation where
prompts is not included per se, but which we might want to add as a
special scheme flavour of python using an import e.g. what is the
natural thing to expect for the variables that are assigned.


Also in the previous email I had a suggestion to for each with
variable, a, add two slots in the stack e.g.

a1
val1
s2
val2
...

But there is a good reason to asign a kind to this as well e.g.
a1
val
kind
a2
val2
kand2
...

then we could use a predicates when we rewind a continuation e.g.

at rewind:
(when (pred1 kind1)
   (set! a1 (ref-val val1)))
...

and and at wind
(when (pred2 kind1)
   (set-val val1 a1))
...

A simple version of this with a complex implementation is what I
actually use in guile-log. 

BTW after this deep realizations of the guile variable behavior I'm 
ready
to implement a much improved version of these special variables in
guile-log that is both efficient and featureful. Cool!

Have fun
/Stefan

      

Re: Special variables to relax boxing

[Mark H Weaver]

Stefan, you're still describing your proposal in terms of low-level
implementation details such as stacks.  In the general case, we cannot
store environment structures on the stack.  Furthermore, in the general
case *all* variables in scheme are bound to locations, not values.  Only
in special cases can we use stacks, and only in special cases can we
avoid boxing variables.  These are only _optimizations_.

If you're serious about this proposal, please read sections 3.1 and 3.4
of the R5RS carefully.  Explain your proposed _semantics_ (not the
implementation details) in those terms, where *all* variables are bound
to _locations_, and where there is no stack at all (everything is
conceptually stored in a garbage-collected heap).

We need to understand the *semantics* in the simplest possible terms
before we even begin to think about how to implement it.

    Thanks,
      Mark

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

On Thursday, March 21, 2013 03:03:06 PM Mark H Weaver wrote:
> Stefan, you're still describing your proposal in terms of low-level
> implementation details such as stacks.  In the general case, we cannot
> store environment structures on the stack.  Furthermore, in the
> general case *all* variables in scheme are bound to locations, not
> values.  Only in special cases can we use stacks, and only in special
> cases can we avoid boxing variables.  These are only _optimizations_.
> 
> If you're serious about this proposal, please read sections 3.1 and
> 3.4 of the R5RS carefully.  Explain your proposed _semantics_ (not
> the implementation details) in those terms, where *all* variables are
> bound to _locations_, and where there is no stack at all (everything
> is conceptually stored in a garbage-collected heap).
> 
> We need to understand the *semantics* in the simplest possible terms
> before we even begin to think about how to implement it.
> 
>     Thanks,
>       Mark

Ok, the sematics for the simple version is are,

Assume k, the continuation associated with with a dynamic wind or
unwind assume that there is a map from each continuation (k,id) 
to a value and getting and setting of this value is done through
ref-get and ref-set, assume that the winder and the rewinder lambda 
takes a first argument k beeing the continuation under action, finally
make-id will make a unique object. then the semantic would be:

(define-syntax-rule (with-special (a) code)
  (let ((id (make-id)))
    (dynamic-wind 
       (lambda (k) (set! a (ref-get k id)))
       (lambda () code)
       (lambda (k)  (ref-set! k id a)))))

A possible refinment of this is
associate to k two predicates e.g.
 (do-wind? k kind) predicate and a (do-unwind? k kind) wich takes
a parameter kind, then use the semanics

(define-syntax-rule (with-special (a kind) code)
  (let ((id (make-id)))
    (dynamic-wind 
       (lambda (k) 
         (when (do-wind? k kind) 
           (set! a (ref-get k id))))
       (lambda () code)
       (lambda (k)  
         (when (do-unwind? k kind)
           (ref-set! k id a))))))

Hopes this helps!

/Stefan

Re: Special variables to relax boxing

[Noah Lavine]

[-- Attachment #1: Type: text/plain, Size: 4271 bytes --]

Hi,

Stefan and Mark, I think you are talking past each other. Stefan is
offering a very concrete definition of what he wants, and Mark is looking
for a more abstract version. Here is what I think Stefan wants, in the
language of R5RS' storage model:

A variable is simply a name for a particular location, and each variable
refers to its own unique location. When a continuation is captured, that
continuation gets its own set of "mirror" locations, one for each variable
that is in the scope of the continuation. These "mirror" locations are
initialized with the same values that were in the locations of the
corresponding variables, but they are distinct from those locations and are
immutable.

When a continuation is called, it is run in an environment in which each of
the variables that was in scope when it was captured points to a new
location, which is initialized to have the same value as the corresponding
"mirror" location.

Note that each variable name gets at least three distinct locations in this
description: the original location, when the program was being run, the
"mirror" location, when the continuation was captured, and the new
location, when the continuation was called. I believe this is sufficient
(and necessary?) to give the semantics that Stefan wants.

Let me also give a more concrete example, which I believe captures *why*
this is important. Let's say you're writing a loop with a counter that says
when to terminate:

(let ((count 0))
  (let iter ()
    ... do-some-stuff ...
    (when (< count 1000000)
      (set! count (+ count 1))
      (iter))))

Now pretend that do-some-stuff captures its continuation when count is
equal to 10. Stefan wants a situation where, no matter how many times that
continuation is called, *each call* to the continuation will have (= count
10). I think this is very natural if you're using an imperative style, but
I'm not sure what the best way is to achieve it.

Best,
Noah


On Thu, Mar 21, 2013 at 4:15 PM, Stefan Israelsson Tampe <
stefan.itampe@gmail.com> wrote:

> On Thursday, March 21, 2013 03:03:06 PM Mark H Weaver wrote:
> > Stefan, you're still describing your proposal in terms of low-level
> > implementation details such as stacks.  In the general case, we cannot
> > store environment structures on the stack.  Furthermore, in the
> > general case *all* variables in scheme are bound to locations, not
> > values.  Only in special cases can we use stacks, and only in special
> > cases can we avoid boxing variables.  These are only _optimizations_.
> >
> > If you're serious about this proposal, please read sections 3.1 and
> > 3.4 of the R5RS carefully.  Explain your proposed _semantics_ (not
> > the implementation details) in those terms, where *all* variables are
> > bound to _locations_, and where there is no stack at all (everything
> > is conceptually stored in a garbage-collected heap).
> >
> > We need to understand the *semantics* in the simplest possible terms
> > before we even begin to think about how to implement it.
> >
> >     Thanks,
> >       Mark
>
> Ok, the sematics for the simple version is are,
>
> Assume k, the continuation associated with with a dynamic wind or
> unwind assume that there is a map from each continuation (k,id)
> to a value and getting and setting of this value is done through
> ref-get and ref-set, assume that the winder and the rewinder lambda
> takes a first argument k beeing the continuation under action, finally
> make-id will make a unique object. then the semantic would be:
>
> (define-syntax-rule (with-special (a) code)
>   (let ((id (make-id)))
>     (dynamic-wind
>        (lambda (k) (set! a (ref-get k id)))
>        (lambda () code)
>        (lambda (k)  (ref-set! k id a)))))
>
> A possible refinment of this is
> associate to k two predicates e.g.
>  (do-wind? k kind) predicate and a (do-unwind? k kind) wich takes
> a parameter kind, then use the semanics
>
> (define-syntax-rule (with-special (a kind) code)
>   (let ((id (make-id)))
>     (dynamic-wind
>        (lambda (k)
>          (when (do-wind? k kind)
>            (set! a (ref-get k id))))
>        (lambda () code)
>        (lambda (k)
>          (when (do-unwind? k kind)
>            (ref-set! k id a))))))
>
> Hopes this helps!
>
> /Stefan
>
>
>

[-- Attachment #2: Type: text/html, Size: 5231 bytes --]

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

[-- Attachment #1: Type: text/plain, Size: 3228 bytes --]

Hi list, Mark and Noah,

Yesterday I noticed that the sematics for special variables are quite
close to fluids and decied to see if I could model special variables
ontop of that with-fluids semantics. That was pretty easy. The basic
difference between fluid and special variables is that with fluids one
swaps between the storages at the with-fluids point, both backwards
and forwards. in the case of special variables one bascially takes on
half of the swap at the wind and the other half at the unwind. So it
become quite easy to just copy the fluid logic and then slightly
modify that source. The scheme compilation part is a little hacky but
it was not that hard to plumb an acceptable solution for testing. I
did verify that it manages the value as said and noticed a 10x
increase of speed when it comes to code passing into a with-fluids
without any prompts compared to any possible setup using dynamic-wind
and fluids. The system is still pretty rough though but there are some
significant optimization implemented.

a preliminary git diff is attached for you to play with.

I did try to implement special variables in current guile. I found
that it is pretty difficult to get the correct semantics working
anyone able to spot it. I use,


(define guards (make-vector 10))
(let lp ((i 0))
  (when (< i 10) (vector-set! guards i (make-fluid))))

(define-syntax with-special-soft 
  (lambda (x)
    (syntax-case x ()
      ((_ (x ...) code ...)
       (with-syntax (((((a k) ...) (y ...))
                      (let loop ((i 0) (l #'(x ...)) (r '()))
                        (if (or (= i 10) (null? l))
                            (list (reverse r) l)
                            (loop (+ i 1) (cdr l) (cons (car l) r))))))
        (with-syntax (((i ...) (iota (length #'(a ...)))))                    
            (if (null? #'(y ...))
            #'(with-fluids (((vector-ref guards i) a) ...)
                (with-special* ((i a k) ...)
                 code ...))
            #'(with-fluids (((vector-ref guards i) a) ...)
                (with-special* ((i a k) ...)
                   (with-special-soft (y ...) code ...))))))))))

(define special-wind-guard (make-fluid (lambda (x) #t)))
(define-syntax-rule (with-special* ((i a k) ...) code ...)
  (dynamic-wind
      (lambda () 
        (set! a (fluid-ref (vector-ref guards i)))
        ...)
      (lambda () 
        code ...)
      (lambda y
        (fluid-set! (vector-ref guards i) a)
        ...)))

(define (f x) 
  (let ((s 0)) 
    (with-special-soft ((s 0)) 
       (let lp ((i 0)) 
          (cond 
             ((>= i 100) s) 
             ((= i 50) (abort-to-prompt 'tag) (lp (+ i 1))) 
             (else (set! s (+ s i)) (lp (+ i 1))))))))

(define k (call-with-prompt 'tag (lambda () (f 1)) (lambda (k . l)
k)))

scheme@(guile-user)> (k)
$1 = 4900
scheme@(guile-user)> (k)
$2 = 8575

Can you spot the bug?

The example works very well with my hardcoded version code and is as
fast as this logic can get, much better than 10x faster because this
case can be very well optimized.

To note here also is that with this code we might get into stack
issues due to the with-special can spoil tail call stack features just
as with-fluids.

WDYT?

/Stefan

[-- Attachment #2: special.diff --]
[-- Type: text/x-patch, Size: 27750 bytes --]

diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index 14dd861..76c4889 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -244,6 +244,11 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
           scm_i_swap_with_fluids (wind_elt,
                                   SCM_I_CURRENT_THREAD->dynamic_state);
 	}
+      else if (SCM_WITH_SPECIAL_P (wind_elt))
+	{
+          scm_i_with_special_from_guard (wind_elt,
+				       SCM_I_CURRENT_THREAD->dynamic_state);
+	}
       else if (SCM_PROMPT_P (wind_elt))
         ; /* pass -- see vm_reinstate_partial_continuation */
       else if (scm_is_pair (wind_elt))
@@ -277,6 +282,11 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
           scm_i_swap_with_fluids (wind_elt,
                                   SCM_I_CURRENT_THREAD->dynamic_state);
 	}
+      else if (SCM_WITH_SPECIAL_P (wind_elt))
+	{
+          scm_i_with_special_to_guard (wind_elt,
+				       SCM_I_CURRENT_THREAD->dynamic_state);
+	}
       else if (SCM_PROMPT_P (wind_elt))
         ; /* pass -- though we could invalidate the prompt */
       else if (scm_is_pair (wind_elt))
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 327d12f..c43011d 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -346,6 +346,47 @@ scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals)
 
   return ret;
 }
+
+const int nguards = 10;
+SCM guards[10];
+SCM scm_i_make_with_special (size_t n, SCM *fluids, SCM *vals)
+{
+  SCM ret;
+  if(n > nguards)
+    scm_misc_error ("with-special", 
+		    "VM with-special can maximally be called with 10 slots",
+                    SCM_EOL);
+
+  /* Ensure that there are no duplicates in the fluids set -- an N^2 operation,
+     but N will usually be small, so perhaps that's OK. */
+  {
+    size_t i, j;
+
+    for (j = n; j--;)
+      for (i = j; i--;)
+        if (scm_is_eq (fluids[i], fluids[j]))
+          {
+            vals[i] = vals[j]; /* later bindings win */
+            n--;
+            fluids[j] = fluids[n];
+            vals[j] = vals[n];
+            break;
+          }
+  }
+        
+  ret = scm_words (scm_tc7_with_special | (n << 8), 1 + n*2);
+  SCM_SET_CELL_WORD_1 (ret, n);
+
+  while (n--)
+    {
+      if (SCM_UNLIKELY ( !SCM_VARIABLEP (fluids[n])))
+        scm_wrong_type_arg ("with-special need a box as input", 0, fluids[n]);
+      SCM_SET_CELL_OBJECT (ret, 1 + n * 2, fluids[n]);
+      SCM_SET_CELL_OBJECT (ret, 2 + n * 2, vals[n]);
+    }
+
+  return ret;
+}
   
 void
 scm_i_swap_with_fluids (SCM wf, SCM dynstate)
@@ -385,6 +426,80 @@ scm_i_swap_with_fluids (SCM wf, SCM dynstate)
       SCM_WITH_FLUIDS_SET_NTH_VAL (wf, i, x);
     }
 }
+
+void
+scm_i_with_special_to_guard (SCM wf, SCM dynstate)
+{
+  SCM fluids;
+  size_t i, max = 0;
+
+  fluids = DYNAMIC_STATE_FLUIDS (dynstate);
+
+  /* We could cache the max in the with-fluids, but that would take more mem,
+     and we're touching all the fluids anyway, so this per-swap traversal should
+     be OK. */
+  for (i = 0; i < SCM_WITH_SPECIAL_LEN (wf); i++)
+    {
+      size_t num = FLUID_NUM (guards[i]);
+      max = (max > num) ? max : num;
+    }
+
+  if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+    {
+      /* Lazily grow the current thread's dynamic state.  */
+      grow_dynamic_state (dynstate);
+
+      fluids = DYNAMIC_STATE_FLUIDS (dynstate);
+    }
+
+  /* Bind the fluids. Order doesn't matter, as all fluids are distinct. */
+  for (i = 0; i < SCM_WITH_SPECIAL_LEN (wf); i++)
+    {
+      size_t fluid_num;
+      
+      fluid_num = FLUID_NUM (guards[i]);
+      SCM_SIMPLE_VECTOR_SET 
+	(fluids, fluid_num,
+	 SCM_VARIABLE_REF (SCM_WITH_SPECIAL_NTH_VAR (wf, i)));
+    }
+}
+
+void
+scm_i_with_special_from_guard (SCM wf, SCM dynstate)
+{
+  SCM fluids;
+  size_t i, max = 0;
+
+  fluids = DYNAMIC_STATE_FLUIDS (dynstate);
+
+  /* We could cache the max in the with-fluids, but that would take more mem,
+     and we're touching all the fluids anyway, so this per-swap traversal should
+     be OK. */
+  for (i = 0; i < SCM_WITH_SPECIAL_LEN (wf); i++)
+    {
+      size_t num = FLUID_NUM ( guards[i]);
+      max = (max > num) ? max : num;
+    }
+
+  if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+    {
+      /* Lazily grow the current thread's dynamic state.  */
+      grow_dynamic_state (dynstate);
+
+      fluids = DYNAMIC_STATE_FLUIDS (dynstate);
+    }
+
+  /* Bind the fluids. Order doesn't matter, as all fluids are distinct. */
+  for (i = 0; i < SCM_WITH_SPECIAL_LEN (wf); i++)
+    {
+      size_t fluid_num;
+      SCM x;
+      
+      fluid_num = FLUID_NUM (guards[i]);
+      x = SCM_SIMPLE_VECTOR_REF (fluids, fluid_num);
+      SCM_VARIABLE_SET (SCM_WITH_SPECIAL_NTH_VAR (wf, i), x);
+    }
+}
   
 SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, 
 	    (SCM fluids, SCM values, SCM thunk),
@@ -592,6 +707,12 @@ SCM_DEFINE (scm_with_dynamic_state, "with-dynamic-state", 2, 0, 0,
 void
 scm_init_fluids ()
 {
+  int i;
+  for(i = 0; i < nguards; i++)
+  {
+    guards[i] = scm_make_fluid();
+  }
+
 #include "libguile/fluids.x"
 }
 
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 2b91ff3..6a593a7 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -38,6 +38,12 @@
 #define SCM_WITH_FLUIDS_NTH_VAL(x,n) (SCM_CELL_OBJECT ((x), 2 + (n)*2))
 #define SCM_WITH_FLUIDS_SET_NTH_VAL(x,n,v) (SCM_SET_CELL_OBJECT ((x), 2 + (n)*2, (v)))
 
+#define SCM_WITH_SPECIAL_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_with_special)
+#define SCM_WITH_SPECIAL_LEN(x) (SCM_CELL_WORD ((x), 0) >> 8)
+#define SCM_WITH_SPECIAL_NTH_VAR(x,n) (SCM_CELL_OBJECT ((x), 1 + (n)*2))
+#define SCM_WITH_SPECIAL_NTH_KIND(x,n) (SCM_CELL_OBJECT ((x), 2 + (n)*2))
+
+
 
 /* Fluids.
 
@@ -73,6 +79,12 @@ SCM_API SCM scm_fluid_bound_p (SCM fluid);
 SCM_INTERNAL SCM scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals);
 SCM_INTERNAL void scm_i_swap_with_fluids (SCM with_fluids, SCM dynamic_state);
 
+SCM_INTERNAL SCM scm_i_make_with_special (size_t n, SCM *fluids, SCM *vals);
+SCM_INTERNAL void scm_i_with_special_from_guard 
+(SCM with_fluids, SCM dynamic_state);
+SCM_INTERNAL void scm_i_with_special_to_guard
+(SCM with_fluids, SCM dynamic_state);
+
 SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals,
 			       SCM (*cproc)(void *), void *cdata);
 SCM_API SCM scm_c_with_fluid (SCM fluid, SCM val,
diff --git a/libguile/tags.h b/libguile/tags.h
index a3032bf..869a9d4 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -426,7 +426,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define scm_tc7_program		79
 #define scm_tc7_array		85
 #define scm_tc7_bitvector	87
-#define scm_tc7_unused_20	93
+#define scm_tc7_with_special	93
 #define scm_tc7_unused_11	95
 #define scm_tc7_unused_12	101
 #define scm_tc7_unused_18	103
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 34545dd..f9e8151 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1556,6 +1556,7 @@ VM_DEFINE_INSTRUCTION (89, wind_fluids, "wind-fluids", 1, -1, 0)
   NEXT;
 }
 
+
 VM_DEFINE_INSTRUCTION (90, unwind_fluids, "unwind-fluids", 0, 0, 0)
 {
   SCM wf;
@@ -1565,6 +1566,30 @@ VM_DEFINE_INSTRUCTION (90, unwind_fluids, "unwind-fluids", 0, 0, 0)
   NEXT;
 }
 
+
+VM_DEFINE_INSTRUCTION (99, wind_special, "wind-special", 1, -1, 0)
+{
+  unsigned n = FETCH ();
+  SCM wf;
+  
+  SYNC_REGISTER ();
+  sp -= 2 * n;
+  CHECK_UNDERFLOW ();
+  wf = scm_i_make_with_special (n, sp + 1, sp + 1 + n);
+  NULLSTACK (2 * n);
+
+  //This is not nessesary
+  //scm_i_swap_with_special (wf, current_thread->dynamic_state);
+  scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (100, unwind_special, "unwind-special", 0, 0, 0)
+{
+  scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+  NEXT;
+}
+
 VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1, 1)
 {
   size_t num;
diff --git a/module/Makefile.am b/module/Makefile.am
index c47d0b4..b07c342 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -101,6 +101,7 @@ SCHEME_LANG_SOURCES =						\
   language/scheme/decompile-tree-il.scm
 
 TREE_IL_LANG_SOURCES =						\
+  language/tree-il/special.scm					\
   language/tree-il/primitives.scm				\
   language/tree-il/effects.scm                                 	\
   language/tree-il/fix-letrec.scm                               \
@@ -337,6 +338,7 @@ OOP_SOURCES = \
   oop/goops/simple.scm
 
 SYSTEM_SOURCES =				\
+  system/vm/special-variable.scm                \
   system/vm/inspect.scm				\
   system/vm/coverage.scm			\
   system/vm/frame.scm				\
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index badce9f..50d64b8 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -151,7 +151,7 @@
     (hashq-set! res k v)
     res))
 
-(define (analyze-lexicals x)
+(define* (analyze-lexicals x #:optional (special-vars #f))
   ;; bound-vars: lambda -> (sym ...)
   ;;  all identifiers bound within a lambda
   (define bound-vars (make-hash-table))
@@ -159,6 +159,9 @@
   ;;  all identifiers referenced in a lambda, but not bound
   ;;  NB, this includes identifiers referenced by contained lambdas
   (define free-vars (make-hash-table))
+  ;; free-syms: sym -> #t
+  ;;   All variables that is free with respect to a lambda.
+  (define free-syms (make-hash-table))
   ;; assigned: sym -> #t
   ;;  variables that are assigned
   (define assigned (make-hash-table))
@@ -180,7 +183,7 @@
       (analyze! x new-proc (append labels labels-in-proc) #t #f))
     (define (recur x new-proc) (analyze! x new-proc '() tail? #f))
     (record-case x
-      ((<application> proc args)
+      ((<application> proc args)                              
        (apply lset-union eq? (step-tail-call proc args)
               (map step args)))
 
@@ -236,6 +239,9 @@
        (let ((free (recur body x)))
          (hashq-set! bound-vars x (reverse! (hashq-ref bound-vars x)))
          (hashq-set! free-vars x free)
+         (for-each (lambda (var)
+                     (hashq-set! free-syms var #t))
+                   free)
          free))
       
       ((<lambda-case> opt kw inits gensyms body alternate)
@@ -286,7 +292,8 @@
                      ;; recur/labels instead of recur
                      (hashq-set! bound-vars x '())
                      (let ((free (recur/labels body x gensyms)))
-                       (hashq-set! bound-vars x (reverse! (hashq-ref bound-vars x)))
+                       (hashq-set! bound-vars x 
+                                   (reverse! (hashq-ref bound-vars x)))
                        (hashq-set! free-vars x free)
                        free))))
                 vals))
@@ -330,7 +337,11 @@
                               (append (hashq-ref bound-vars val)
                                       (hashq-ref bound-vars proc)))
                   (hashq-remove! bound-vars val)
-                  (hashq-remove! free-vars val))))
+                  (hashq-remove! free-vars val))
+                ;; Else we will allocate a closure; register the free-syms
+                (for-each (lambda (sym)
+                            (hashq-set! free-syms sym #t))
+                          (hashq-ref free-vars val))))
           gensyms vals)
          (lset-difference eq?
                           (apply lset-union eq? body-refs var-refs)
@@ -395,7 +406,12 @@
              (begin
                (hashq-set! (hashq-ref allocation (car c))
                            x
-                           `(#f ,(hashq-ref assigned (car c)) . ,n))
+                           `(#f ,(and (hashq-ref assigned (car c))
+                                      (not (and special-vars
+                                                (hashq-ref special-vars (car c))
+                                                (not (hashq-ref free-syms 
+                                                                (car c))))))
+                                . ,n))
                (lp (cdr c) (1+ n)))))
       
        (let ((nlocs (allocate! body x 0))
@@ -427,7 +443,15 @@
               (begin
                 (hashq-set! allocation (car gensyms)
                             (make-hashq
-                             proc `(#t ,(hashq-ref assigned (car gensyms)) . ,n)))
+                             proc `(#t 
+                                    ,(and (hashq-ref assigned (car gensyms))
+                                          (not (and special-vars
+                                                    (hashq-ref special-vars 
+                                                               (car gensyms))
+                                                    (not (hashq-ref 
+                                                          free-syms 
+                                                          (car gensyms))))))
+                                       . ,n)))
                 (lp (cdr gensyms) (1+ n)))))
         (if alternate (allocate! alternate proc n) n)))
       
@@ -456,7 +480,12 @@
                    (hashq-set!
                     allocation v
                     (make-hashq proc
-                                `(#t ,(hashq-ref assigned v) . ,n)))
+                                `(#t ,(and (hashq-ref assigned v)
+                                      (not (and special-vars
+                                                (hashq-ref special-vars v)
+                                                (not (hashq-ref free-syms 
+                                                                v)))))
+                                     . ,n)))
                    (lp (cdr gensyms) (1+ n)))))))))
       
       ((<letrec> gensyms vals body)
@@ -471,7 +500,12 @@
                (hashq-set!
                 allocation v
                 (make-hashq proc
-                            `(#t ,(hashq-ref assigned v) . ,n)))
+                            `(#t ,(and (hashq-ref assigned v)
+                                      (not (and special-vars
+                                                (hashq-ref special-vars v)
+                                                (not (hashq-ref free-syms 
+                                                                v)))))
+                                 . ,n)))
                (lp (cdr gensyms) (1+ n))))))
 
       ((<fix> gensyms vals body)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index e4df6e1..b4d3836 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -29,6 +29,7 @@
   #:use-module (language tree-il optimize)
   #:use-module (language tree-il canonicalize)
   #:use-module (language tree-il analyze)
+  #:use-module (language tree-il special)
   #:use-module ((srfi srfi-1) #:select (filter-map))
   #:export (compile-glil))
 
@@ -64,9 +65,10 @@
 
   (let* ((x (make-lambda (tree-il-src x) '()
                          (make-lambda-case #f '() #f #f #f '() '() x #f)))
-         (x (optimize! x e opts))
+         (x (optimize! (optimize! x e opts) e opts))
          (x (canonicalize! x))
-         (allocation (analyze-lexicals x)))
+         (special-vars (register-special-vars x))
+         (allocation (analyze-lexicals x special-vars)))
 
     (with-fluids ((*comp-module* e))
       (values (flatten-lambda x #f allocation)
@@ -199,6 +201,19 @@
     (proc emit-code)
     (reverse out)))
 
+(define (with-special? x)
+  (record-case x
+    ((<application> src proc args)
+     (record-case proc
+       ((<module-ref> src mod name public?)
+        (and (equal? mod '(system vm special-variable))
+             (eq?    name 'w-special)
+             (= (length args) 1)
+             (car args)))
+       (else #f)))
+    (else #f)))
+
+
 (define (flatten-lambda x self-label allocation)
   (record-case x
     ((<lambda> src meta body)
@@ -229,6 +244,7 @@
     (define (comp-vals tree MVRA) (comp tree 'vals #f MVRA))
     (define (comp-fix tree RA) (comp tree context RA MVRA))
 
+    ;; Use this helper to guard some syms
     ;; A couple of helpers. Note that if we are in tail context, we
     ;; won't have an RA.
     (define (maybe-emit-return)
@@ -236,6 +252,15 @@
           (emit-branch #f 'br RA)
           (if (eq? context 'tail)
               (emit-code #f (make-glil-call 'return 1)))))
+
+    (define (is-boxed? x)
+      (record-case x
+        ((<lexical-ref> src gensym)
+         (pmatch (hashq-ref (hashq-ref allocation gensym) self)
+                 ((,local? ,boxed? . ,index)
+                  boxed?)
+                 (_ #f)))
+        (else #f)))
     
     ;; After lexical binding forms in non-tail context, call this
     ;; function to clear stack slots, allowing their previous values to
@@ -255,7 +280,25 @@
                           (,loc (error "bad let var allocation" x loc))))))
                    syms))))
 
-    (record-case x
+    (if (pair? x)
+        (case (car x)
+          ((raw-ref)
+           (record-case (cdr x)
+            ((<lexical-ref> src gensym)
+             (case context
+               ((push)
+                (pmatch (hashq-ref (hashq-ref allocation gensym) self)
+                        ((,local? ,boxed? . ,index)
+                         (emit-code src 
+                                    (make-glil-lexical local? #f 'ref index)))
+                        (,loc
+                         (error "bad lexical allocation" x loc))))
+               (else
+                (error "Bad raw-ref"))))))
+          (else
+           (error "Bad pair tree-il")))
+
+     (record-case x
       ((<void>)
        (case context
          ((push vals tail)
@@ -277,7 +320,7 @@
                (comp-drop (car exps))
                (lp (cdr exps))))))
 
-      ((<application> src proc args)
+      ((<application> src proc args)       
        ;; FIXME: need a better pattern-matcher here
        (cond
         ((and (primitive-ref? proc)
@@ -1037,11 +1080,38 @@
           (if RA
               (emit-branch #f 'br RA)))))
 
-      ((<dynlet> src fluids vals body)
-       (for-each comp-push fluids)
-       (for-each comp-push vals)
-       (emit-code #f (make-glil-call 'wind-fluids (length fluids)))
-
+      ((<dynlet> src fluids vals body)             
+       (define spc  (let lp ((l (map (lambda (sym val)
+                                       (let ((sp (with-special? val)))
+                                         (and (is-boxed? sym)
+                                              sp)))
+                                     fluids vals)))
+                      (if (pair? l)
+                          (if (car l)
+                              (cons (car l) (lp (cdr l)))
+                              (lp (cdr l)))
+                          '())))
+       (define id   (lambda (x) x))
+       (define spc? (or-map with-special? vals))
+       (if (and spc? (null? spc))
+           (comp-tail body)
+           (begin
+             (if spc?           
+                 (for-each (lambda (ref)
+                             (when (is-boxed? ref)
+                                   (comp-push (cons 'raw-ref ref))))
+                           fluids)
+                 (for-each comp-push fluids))
+             
+             (if spc?
+                 (for-each comp-push spc)
+                 (for-each comp-push vals))
+       
+             (if spc?
+                 (emit-code #f (make-glil-call 'wind-special (length spc)))
+                 (emit-code #f (make-glil-call 'wind-fluids (length fluids))))
+         
+       (begin
        (case context
          ((tail)
           (let ((MV (make-label)))
@@ -1052,17 +1122,23 @@
             ;; ourselves).
             (comp-vals body MV)
             ;; one value: unwind and return
-            (emit-code #f (make-glil-call 'unwind-fluids 0))
+            (if spc?
+                (emit-code #f (make-glil-call 'unwind-special 0))
+                (emit-code #f (make-glil-call 'unwind-fluids 0)))
             (emit-code #f (make-glil-call 'return 1))
             
             (emit-label MV)
             ;; multiple values: unwind and return values
-            (emit-code #f (make-glil-call 'unwind-fluids 0))
+            (if spc?
+                (emit-code #f (make-glil-call 'unwind-special 0))
+                (emit-code #f (make-glil-call 'unwind-fluids 0)))
             (emit-code #f (make-glil-call 'return/nvalues 1))))
          
          ((push)
           (comp-push body)
-          (emit-code #f (make-glil-call 'unwind-fluids 0)))
+          (if spc?
+              (emit-code #f (make-glil-call 'unwind-special 0))
+              (emit-code #f (make-glil-call 'unwind-fluids 0))))
          
          ((vals)
           (let ((MV (make-label)))
@@ -1072,16 +1148,20 @@
             
             (emit-label MV)
             ;; multiple values: unwind and goto MVRA
-            (emit-code #f (make-glil-call 'unwind-fluids 0))
+            (if spc?
+                (emit-code #f (make-glil-call 'unwind-special 0))
+                (emit-code #f (make-glil-call 'unwind-fluids 0)))
             (emit-branch #f 'br MVRA)))
          
          ((drop)
           ;; compile body, discarding values. then unwind...
           (comp-drop body)
-          (emit-code #f (make-glil-call 'unwind-fluids 0))
+            (if spc?
+                (emit-code #f (make-glil-call 'unwind-special 0))
+                (emit-code #f (make-glil-call 'unwind-fluids 0)))
           ;; and fall through, or goto RA if there is one.
           (if RA
-              (emit-branch #f 'br RA)))))
+              (emit-branch #f 'br RA))))))))
 
       ((<dynref> src fluid)
        (case context
@@ -1202,4 +1282,4 @@
           (emit-code #f (make-glil-mv-bind 1 #f)))
          ((vals)
           ;; Go to MVRA.
-          (emit-branch #f 'br MVRA)))))))
+          (emit-branch #f 'br MVRA))))))))
diff --git a/module/language/tree-il/special.scm b/module/language/tree-il/special.scm
new file mode 100644
index 0000000..0e38084
--- /dev/null
+++ b/module/language/tree-il/special.scm
@@ -0,0 +1,104 @@
+(define-module (language tree-il special)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
+  #:use-module (system base syntax)
+  #:use-module (system base message)
+  #:use-module (system vm program)
+  #:use-module (language tree-il)
+  #:use-module (system base pmatch)
+  #:export (register-special-vars))
+
+
+(define (register-special-vars x)
+  (define register (make-hash-table))
+  (let lp ((x x))
+    (record-case x
+      ((<application> proc args)                              
+       (record-case proc
+         ((<module-ref> src mod name public?)
+          (if (and (equal? mod '(system vm special-variable))
+                   (eq?    name 'special)
+                   (= (length args) 1))
+              (record-case (car args)
+                ((<lexical-ref> src gensym)
+                 (hashq-set! register gensym #t))
+                (else #t))))
+         (else #f))
+       (lp proc)
+       (for-each lp args))
+
+      ((<conditional> test consequent alternate)
+       (lp test)
+       (lp consequent)
+       (lp alternate))
+
+          
+      ((<lexical-set> gensym exp)
+       (lp exp))
+
+      ((<module-set> exp)
+       (lp exp))
+      
+      ((<toplevel-set> exp)
+       (lp exp))
+      
+      ((<toplevel-define> exp)
+       (lp exp))
+      
+      ((<sequence> exps)
+       (for-each lp exps))
+
+      ((<lambda> body)
+       (lp body))
+      
+      ((<lambda-case> opt kw inits gensyms body alternate)
+       (for-each lp inits)
+       (lp body)
+       (if alternate (lp alternate)))
+      
+      ((<let> gensyms vals body)
+       (for-each lp vals)
+       (lp body))
+
+      ((<letrec> gensyms vals body)
+       (for-each lp vals)
+       (lp body))
+      
+      ((<fix> gensyms vals body)
+       (for-each lp vals)
+       (lp body))
+
+      ((<let-values> exp body)
+       (lp exp)
+       (lp body))
+      
+      ((<dynwind> body winder unwinder)
+       (lp body)
+       (lp winder)
+       (lp unwinder))
+      
+      ((<dynlet> fluids vals body)
+       (lp body)
+       (for-each lp (append fluids vals)))
+          
+      ((<dynref> fluid)
+       (lp fluid))
+      
+      ((<dynset> fluid exp)
+       (lp fluid) (lp exp))
+      
+      ((<prompt> tag body handler)
+       (lp tag) 
+       (lp body) 
+       (lp handler))
+      
+      ((<abort> tag args tail)
+       (lp tag) (lp tail) (for-each lp args))
+      
+      (else #t)))
+  register)
+
diff --git a/module/system/vm/special-variable.scm b/module/system/vm/special-variable.scm
new file mode 100644
index 0000000..99cc497
--- /dev/null
+++ b/module/system/vm/special-variable.scm
@@ -0,0 +1,85 @@
+(define-module (system vm special-variable)
+  #:export (with-special with-special-soft special-wind-guard))
+
+(define special      (lambda (x) x))
+(define w-special (lambda (x) x))
+
+(define-syntax-rule (mark-as-special v ...)
+  (begin
+    (special v)
+    ...
+    (if #f #f)))
+
+;; This will allocate guard on the stack as a boxed value
+(define (make-winder l)
+  (lambda ()
+    (let loop ((l l))
+      (if (pair? l)
+          (let ((c (car l)))
+            (variable-set! (cdr c) (car c))
+            (loop (cdr l)))
+          (if #f #f)))))
+
+(define (make-unwinder l)
+  (lambda ()
+    (let loop ((l l))
+      (if (pair? l)
+          (let ((c (car l)))
+            (set-car! c (variable-ref (cdr c)))
+            (loop (cdr l)))
+          (if #f #f)))))
+
+(define-syntax with-special 
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (x ...) code ...)
+       (with-syntax (((((a k) ...) (y ...))
+                      (let loop ((i 0) (l #'(x ...)) (r '()))
+                        (if (or (= i 10) (null? l))
+                            (list (reverse r) l)
+                            (loop (+ i 1) (cdr l) (cons (car l) r))))))
+        (if (null? #'(y ...))
+            #'(with-fluids ((a (w-special k)) ...)
+                 (mark-as-special a) ...
+                 code ...)
+            #'(with-fluids ((a (w-special k)) ...)
+                 (mark-as-special a) ...
+                 (with-special (y ...) code ...))))))))
+
+(define guards (make-vector 10))
+(let lp ((i 0))
+  (when (< i 10) (vector-set! guards i (make-fluid))))
+
+(define-syntax with-special-soft 
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (x ...) code ...)
+       (with-syntax (((((a k) ...) (y ...))
+                      (let loop ((i 0) (l #'(x ...)) (r '()))
+                        (if (or (= i 10) (null? l))
+                            (list (reverse r) l)
+                            (loop (+ i 1) (cdr l) (cons (car l) r))))))
+        (with-syntax (((i ...) (iota (length #'(a ...)))))                    
+            (if (null? #'(y ...))
+            #'(with-fluids (((vector-ref guards i) a) ...)
+                (with-special* ((i a k) ...)
+                 code ...))
+            #'(with-fluids (((vector-ref guards i) a) ...)
+                (with-special* ((i a k) ...)
+                   (with-special-soft (y ...) code ...))))))))))
+
+(define special-wind-guard (make-fluid (lambda (x) #t)))
+(define-syntax-rule (with-special* ((i a k) ...) code ...)
+  (dynamic-wind
+      (lambda () 
+        (when ((fluid-ref special-wind-guard) k)            
+              (set! a (fluid-ref (vector-ref guards i))))
+        ...)
+      (lambda () 
+        code ...)
+      (lambda y
+        (fluid-set! (vector-ref guards i) a)
+        ...)))
+
+
+

Re: Special variables to relax boxing

[Daniel Hartwig]

On 23 March 2013 06:33, Stefan Israelsson Tampe <stefan.itampe@gmail.com> wrote:
> (define (f x)
>   (let ((s 0))
>     (with-special-soft ((s 0))
>        (let lp ((i 0))
>           (cond
>              ((>= i 100) s)
>              ((= i 50) (abort-to-prompt 'tag) (lp (+ i 1)))
>              (else (set! s (+ s i)) (lp (+ i 1))))))))

Is this typical of your intended use case?  Why can S not be part of
the named-let and avoid the use of ‘set!’?

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

Ok, I have felt your punches against the idea and have thought about it
somewhat more.

1. I can only conclude that today it's already difficult to reason about code
with respect to multiple restarts of continuation and the main reason is that
at least I have been sloppy to add a ! to the macros that use set! internally.

To a fun example:

I have been pondering to poer common-lisp iterate for fun to learn and enjoy
guile. In there they have generators e.g. (generati i ...) and then take out the
values with (next i) construct. For a simple i = 1 ... one would expand next i
to (begin (set! i (+ i 1)) i). So next is really next!. So this will
not mix well with
undo and redo. It's possible to define i as a special variable though
and you will
get the feature of proper undo redo support but now another problem appears
we will as Mark and Daniel introduce i into any uses of next i in user
and can get
hard to reason about properties when the value is put into a lambda. So next
is not next or next! but what? maybe next~ To indicate that lambdas that include
this must expect to mutate when one does a redo!. Conventions like this is
problematic because coders will most certainly be sloppy to follow
this convention
resulting in a mess. One really long for a type system to help clarify
the matters here.

Typically macro writers that post a binding a, might want users to use
the underlying
a~, variable as well and it would probably be good practice to let
users refer to this
at will e.g. reference it with (~ a), set it with (set~ a 1) as well
as (set! a 1) and refer
to it with e.g. a just as ordinary scheme. I would suggest that both
reference a variable
with set!,a, and with set~, (~ a) should be an error. Otherwise if the
macro writer
manages the macro  correct and basically uses a user guard that we
should provide
e.g. (with-user (a) user-code ...) especially this means that if a is
set! ed then we know
that redo undo cannot work and we will force the underlying variable
to be a usual
variable.

To accomplish this I would formulate the semantics as follows.

Consider
* k, the r5rs continuation
* dynamic-wind, r5rs dynamic wind with the addition that k is an argument
  to the rewinder.

Introduce (with-special ((a:id kind:object) ...) code ...) and (set~
a:id v:obj)

Let self identifying the dynamic wind object lexically

Introduce
(special-set! self k value)
(special-ref self k)

Also define
(guard-special? k kind)
A setter and a getter of an object indexed by self and k

Then the semantic for with-special in guard mode would be

(let ((last #f))
  (dynamic-wind
     (lambda (k)
        (when (guard-special? k kind)
            (set! a (special-ref self k))))
     (lambda ()
        (call-with-values (lambda () (begin code ...))
           (lambda ret
              (set! last #t)
              (apply values ret))))
     (lambda (k . l)
        (unless last
            (special-set! self k a))))

Guard mode is entered only if a is referenced with set~ and never with
set! if it can be proved
Otherwise guard mode is never entered. The semantics of set~ is the
same as with set! otherwise.

if with-special is not in guard-mode then it behaves just as (let ()  code ....)

I really hope that I mange to converge a good concept with this discussion!

WDYT










On Thu, Mar 21, 2013 at 8:03 PM, Mark H Weaver <mhw@netris.org> wrote:
> Stefan, you're still describing your proposal in terms of low-level
> implementation details such as stacks.  In the general case, we cannot
> store environment structures on the stack.  Furthermore, in the general
> case *all* variables in scheme are bound to locations, not values.  Only
> in special cases can we use stacks, and only in special cases can we
> avoid boxing variables.  These are only _optimizations_.
>
> If you're serious about this proposal, please read sections 3.1 and 3.4
> of the R5RS carefully.  Explain your proposed _semantics_ (not the
> implementation details) in those terms, where *all* variables are bound
> to _locations_, and where there is no stack at all (everything is
> conceptually stored in a garbage-collected heap).
>
> We need to understand the *semantics* in the simplest possible terms
> before we even begin to think about how to implement it.
>
>     Thanks,
>       Mark

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

There are some bugs in the semantics. I try to fix them here


Consider
* k, the r5rs continuation
* dynamic-wind, r5rs dynamic wind with the addition that continuation
k is an argument
   to the rewinder.

 Introduce (with-special ((a:id kind:object) ...) code ...) and
(set~  a:id v:obj)

Introduce
(special-set! i k value)
(special-ref i k)
A setter and a getter of an object indexed by i and k

Also define
(guard-special? k kind)

That index an object on k, wich depedning on kind ask to restore the value
of the old saved state.

Let (make-id) generate a unique object

Then the semantic for with-special in guard mode would be

(let ((last #f)
      (i      (make-id)))
   (dynamic-wind
      (lambda (k)
         (set! last #f)
         (when (guard-special? k kind)
             (set! a (special-ref i k))))
      (lambda ()
         (call-with-values (lambda () (begin code ...))
            (lambda ret
               (set! last #t)
               (apply values ret))))
      (lambda (k . l)
         (unless last
             (special-set! i k a))))

 Guard mode is entered only if a is referenced with set~ and never with
 set! if it can be proved
 Otherwise guard mode is never entered. The semantics of set~ is the
 same as with set! otherwise.

 if with-special is not in guard-mode then it behaves just as (let ()
code ....)

Hope that I don't spam the list but guile is a cooperative effort.

/Stefan

Re: Special variables to relax boxing

[Stefan Israelsson Tampe]

Hi guiler, Hi Daniel.

I lost this thread in my mail application, sorry, so I try to continue
this way instead.

* This feature for scheme is mainly for macro writers which knows what 
  they are doing and which only guard state varibles not seen to the 
  application programmer. This is how I use this feature in guile-log 
  so it will not change how most people need to reason about scheme, the 
beuty 
  remains. It makes insanly difficult tasks possible and simple things
  works as before.

* I really like guile to cater for advanced users. Not only
  noobs. Although we should hide this feature really deep and put some
  serious warnings in the documentatin about the use. I actually hate
  using set! and if you look at e.g. guile-syntax-parse you will see
  that I rewrote everything with let loops, e.g. I really prefere that
  way of looping. I do understand your worry to let people loose on
  writing set! heavy code - that is not scheme. I also ported common
  lisp code to scheme and It was a horrible experience to see all set!
  ing in the code and I just had to rewrite quite a lot of the common
  lisp with rewriting the loops. But then a new version comes out and
  you are smoked.

* If we are serious about combining emacs-lisp with guile we should
  really aim to have this feature added with deep support. The reason is 
that
  using set! in lisp world is a style of programming and is very
  common. For this reason I don't expect much emacs-lisp to combine
  well with undo redo additions via prompts. This hearts me really
  hard because it would be so cool to be able and schime in to a
  emacs-lisp project, add  a few lines of code and show of a well 
  functioning redo and undo addition to the complex emacs lisp code - 
  this would be a really good selling point for guile-emacs and as I
  said, I hate that we don't have a nice support for it.

* The proposed semantics piggy packs ontop of fluids sematics so
  everything we have done incorporating fluids carry over directly to
  special variables. And the extra stuff is really not that
  much. E.g. the maintainance burden is probably much less that your
  perception of it.

* We need 2 extra VM op's if we are serious ablut implementing this
  though but they are simply essentially a copy paste of the fluid
  code so one could factor out the code somewhat. Another possibility
  is to add an option to the current fluid vm ops.

* If you don't redo and undo nothing in the way scheme works changes
  it's only when you undo and redo stuff that the semantics becomes 
  important.

I really think that this is an important addition of guile and it would
really be a dissapointment not having it's support considering the
great gain you can get via optimizations with really not much extra
work in guile. Also I think that I managed to get the semantics and
implementation in a really beutiful state where a lot of effort have
been in making it mix well and be consistant in what it does and
actually get it into a state where it _is_ much simpler to reason
about the code considering other way's of implementing the 
optimisations.
Albait more difficult than before.

Have fun
/Stefan