Hi, all...
I've implemented some syntax to make a Pepsi BlockClosure from a Jolt
lambda, for passing to Pepsi functions that expect one. As I
mentioned earlier, my implementation has dynamic extent.
Here is an example:
(let ((frotz 9)
(baz 10)
(bar 11)
(bot 12))
(set baz "hello")
(set bar 42)
(printf "have %p\n" (addrof frotz))
(printf "set %p to %s\n" (addrof baz) baz)
(printf "set %p to %d\n" (addrof bar) bar)
(with-block-closure (frotz baz bar)
(cb (arg1 arg2 arg3)
(printf "cb got args %d %d %d\n" arg1 arg2 arg3)
(printf "cb has %p %s %d\n" (long@ frotz) (long@ baz) (long@ bar))
(set (long@ frotz) 18)
(set (long@ baz) "goodbye")
(set (long@ bar) 24))
[cb value: 1 value: 2 value: 3])
(printf "now have %p %s %d\n" frotz baz bar))
The first sexp is the list of state variables that should be shared
between the caller and the callback. The second sexp is the name of
the callback, its arguments, and its body. The rest of the expression
is the body to execute during which the callback is defined.
When executed, this prints:
have 0xbfce90b8
set 0xbfce90b4 to hello
set 0xbfce90b0 to 42
cb got args 1 2 3
cb has 0x9 hello 42
now have 0x12 goodbye 24
I'm posting this because it Works For Me, but I recognize that it's
not a really great solution. It would be slightly more convenient for
with-block-closure to modify the callback so that all the (long@ VAR)
calls would be implicit (this would give consistent variable names).
It would also be much more convenient for the syntax to infer the
variables to put in the state array, but I'm not a compiler hacker.
Anyway, I hope this helps somebody, or inspires somebody to improve
it!
Thanks,
--
Michael FIG <[EMAIL PROTECTED]> //\
http://michael.fig.org/ \//
;; -*-Lisp-*-
;; with-block-closure.k - Define a dynamic-extent Pepsi closure from Jolt
;; Michael FIG <[EMAIL PROTECTED]>, 2007-07-16
;; Here's how to use it:
;;(let ((frotz 9)
;; (baz 10)
;; (bar 11)
;; (bot 12))
;;
;; (set baz "hello")
;; (set bar 42)
;; (printf "have %p\n" (addrof frotz))
;; (printf "set %p to %s\n" (addrof baz) baz)
;; (printf "set %p to %d\n" (addrof bar) bar)
;;
;; (with-block-closure (frotz baz bar)
;; (cb (arg1 arg2 arg3)
;; (printf "cb got args %d %d %d\n" arg1 arg2 arg3)
;; (printf "cb has %p %s %d\n" (long@ frotz) (long@ baz) (long@ bar))
;; (set (long@ frotz) 18)
;; (set (long@ baz) "goodbye")
;; (set (long@ bar) 24))
;; [cb value: 1 value: 2 value: 3])
;;
;; (printf "now have %p %s %d\n" frotz baz bar))
;; results in:
;;
;; have 0xbff96b68
;; set 0xbff96b64 to hello
;; set 0xbff96b60 to 42
;; cb got args 1 2 3
;; cb has 0x9 hello 42
;; now have 0x12 goodbye 24
;; We need the BlockClosure definition.
(define BlockClosure (import "BlockClosure"))
(syntax with-block-closure
(lambda (node compiler)
(let ((posn '0)
(state-spec [node second])
(state-size [state-spec size])
(state-setters [Expression new: state-size])
(state-getters [Expression new: state-size])
(block-name [[node third] first])
(args [[node third] second])
(arity [args size])
(block-body [[node third] copyFrom: '2])
(body [node copyFrom: '3]))
(while [posn < state-size]
;; Put the address of the variable in the state array.
[state-setters at: posn put:
[Expression
with: 'send with: ''at:put:
with: '_state
with: [Expression with: 'quote with: posn]
with: [Expression with: 'addrof with: [state-spec at: posn]]]]
;; Bind the addresses of the variables from the state array.
;; FIXME: Automatic long@ indirection would be nice.
[state-getters at: posn put:
[Expression
with: [state-spec at: posn]
with: [Expression with: 'send with: ''at:
with: '_state with: [Expression with: 'quote with: posn]]]]
(set posn [posn + '1]))
;;[StdOut print: state-setters] [StdOut cr]
;;[StdOut print: state-getters] [StdOut cr]
`(let ((_state [Array new: ',state-size])
(,block-name [BlockClosure function_:
(lambda (_closure self ,@args)
(let ((_state (long@ (+ self 12)))
,@state-getters)
,@block-body))
arity_: ,arity outer: 0 state: _state nlr_: 0]))
,@state-setters
,@body))))
;; End.
_______________________________________________
fonc mailing list
[email protected]
http://vpri.org/mailman/listinfo/fonc
