On May 18 2013, Jörg F. Wittenberger wrote:
Eventually I learned that the technique I've been looking for is
known singe 2001 by the name "Petrofsky Extraction".
As I'm gaining experience with the Petrofsky extraction, I wonder
how useful it might by to have a version of SRFI-8 `receive`,
which avoids call-with-values (at least under circumstances).
Possible gains:
a) Some run-time errors are caught at compile-time.
b) Returning multiple values is to my knowledge more run-time
expensive than tail calls in chicken.
Downside: `values` is only available as syntax here.
It would be an interesting exercise (I'm beyond my current capabilities)
to have it available as a first class procedure too.
Find attached some test files:
t1.scm: test cases with errors - non of which is caught at compiletime.
t2.scm: a (limited) version of receive, which catches some errors
and avoids call-with-values. However if the multi-value returning
expression returns by calling some other procedure (instead of
having a literal (values x ...) in tail position, the tail call
needs to be wrapped in some crazy `values-from` form.
t3.scm: same as t2.scm, but with magic to handle avoid the need for
`values-from`.
The trick in t3.scm however goes at the expense of always expanding into
call-with-current-continuation and call-with-values. Just that it
returns prior to going through C_values. But I'm afraid the additional
setup costs will be worse than the gain.
At the moment I'm contemplating if it would be possible to rewrite
(preferable using syntax-rules for educational purpose) an expression
such that tail calls are automatically wrapped by something like
`values-from`.
comments welcome
Best
/Jörg
............;; This will become a compiletime error.
(receive (a b c) (values 1 2) (display (cons a b)))
(receive (a b) (let ((x 1) (a 2)) (values x a)) (cons a b))
(receive x (values 1 2 3) x)
(define (foo) (values 1 2))
(receive (a b) (foo) (cons a b))
(define (bar a v) (values a v 1))
;; This one will stay as a runtime error.
(receive (a b) (bar 2 3) (cons a b))
(receive (a b) (receive (a b c) (values 1 2 3) (values c (cons a b))) (vector b a))
(receive (a b) (receive (a b c)
(bar 5 6)
(values c (cons a b)))
(vector b a))
;; `rcv`: A limited "alternative" for SRFI-8 `receive`.
;;
;; This avoids to use call-with-values - which incurs some overhead on
;; chicken. However, it works *only*, if `values` is used in tail
;; call position within the `expr` itself. Havoc if `values` is
;; referenced as a value inside the expression.
;;
;; At least it nests.
;;
;; Another advantage over the buildin receive: wrong number of return
;; values is caught at compile-time.
;;
;; There's some limited (and questionable) magic to support calling
;; procedures which produce multiple values in `expr` by wraping the
;; call into `values-from`.
;; # Petrofsky Extraction
;;
;; How to write dirty R5RS macros
;; http://groups.google.com/groups?selm=87oflzcdwt.fsf%40radish.petrofsky.org
;; How to write seemingly unhygienic macros using syntax-rules
;; Date: 2001-11-19 01:23:33 PST
;;
;; Extract several colored identifiers from a form
;; extract* SYMB-L BODY CONT
;; where SYMB-L is the list of symbols to extract, and BODY and CONT
;; has the same meaning as in extract, see below.
;;
;; The extract* macro expands into
;; (K-HEAD (extr-id-l . K-IDL) . K-ARGS)
;; where extr-id-l is the list of extracted colored identifiers. The
;; extraction itself is performed by the macro extract.
(define-syntax extract*
(syntax-rules ()
;; Extract a colored identifier from a form
;; extract SYMB BODY CONT
;; BODY is a form that may contain an occurence of an identifier
;; that refers to the same binding occurrence as SYMB, perhaps
;; with a different color.
;; CONT is a form of the shape (K-HEAD K-IDL . K-ARGS)
;; where K-IDL are K-ARGS are S-expressions representing lists or
;; the empty list.
;; The extract macro expands into
;; (K-HEAD (extr-id . K-IDL) . K-ARGS)
;; where extr-id is the extracted colored identifier. If symbol
;; SYMB does not occur in BODY at all, extr-id is identical to
;; SYMB.
((_ "extract" symb body _cont)
(letrec-syntax
((tr
(syntax-rules (symb)
((_ x symb tail (cont-head symb-l . cont-args))
(cont-head (x . symb-l) . cont-args)) ; symb has occurred
((_ d (x . y) tail cont) ; if body is a composite form,
(tr x x (y . tail) cont)) ; look inside
((_ d1 d2 () (cont-head symb-l . cont-args))
(cont-head (symb . symb-l) . cont-args)) ; symb does not occur
((_ d1 d2 (x . y) cont)
(tr x x y cont)))))
(tr body body () _cont)))
((_ (symb) body cont) ; only one symbol: use extract to do the job
(extract* "extract" symb body cont))
((_ _symbs _body _cont)
(letrec-syntax
((ex-aux ; extract symbol-by-symbol
(syntax-rules ()
((_ found-symbs () body cont)
(reverse () found-symbs cont))
((_ found-symbs (symb . symb-others) body cont)
(extract* "extract" symb body
(ex-aux found-symbs symb-others body cont)))
))
(reverse ; reverse the list of extracted symbols
(syntax-rules () ; to match the order of SYMB-L
((_ res () (cont-head () . cont-args))
(cont-head res . cont-args))
((_ res (x . tail) cont)
(reverse (x . res) tail cont)))))
(ex-aux () _symbs _body _cont)))))
(define-syntax rcv
(syntax-rules ()
((_ bindings expr body ...)
(let ((receiver (lambda bindings body ...)))
(let-syntax
((rewrite (syntax-rules ()
((_ (*values *vals) *expr)
(let-syntax
((*values (syntax-rules <...> ()
((_ rv <...>) (receiver rv <...>))))
(*vals (syntax-rules <...> ()
((_ (proc))
(call-with-values proc
(lambda bindings (receiver . bindings))))
((_ (proc a <...>))
(call-with-values (lambda () (proc a <...>))
(lambda bindings (receiver . bindings)))))))
*expr)))))
(extract* (values values-from) expr (rewrite () expr)))))))
;; Examples:
;; Compile time error:
;(rcv (a b c) (values 1 2) (display (cons a b)))
(rcv (a b) (let ((x 1) (a 2)) (values x a)) (cons a b))
(rcv x (values 1 2 3) x)
; Havoc example:
;(let ((return values)) (rcv x (return 1 2 3) x))
(define (foo) (values 1 2))
(rcv (a b) (foo) (cons a b)) ;; => fails to exec body because no "values" was found
(rcv (a b) (values-from (foo)) (cons a b))
(define (bar a v) (values a v 1))
;; Runtime error only:
; (rcv (a b) (values-from (bar 2 3)) (cons a b))
(rcv (a b) (rcv (a b c) (values 1 2 3) (values c (cons a b))) (vector b a))
(rcv (a b) (rcv (a b c)
(values-from (bar 5 6))
(values c (cons a b)))
(vector b a))
;; `rcv`: A limited "alternative" for SRFI-8 `receive`.
;;
;; This avoids to use call-with-values - which incurs some overhead on
;; chicken. However, it works *only*, if `values` is used in tail
;; call position within the `expr` itself. Havoc if `values` is
;; referenced as a value inside the expression.
;;
;; At least it nests.
;;
;; Another advantage over the buildin receive: wrong number of return
;; values is caught at compile-time.
;;
;; There's magic to support calling procedures which produce multiple
;; values in `expr`.
;; # Petrofsky Extraction
;;
;; How to write dirty R5RS macros
;; http://groups.google.com/groups?selm=87oflzcdwt.fsf%40radish.petrofsky.org
;; How to write seemingly unhygienic macros using syntax-rules
;; Date: 2001-11-19 01:23:33 PST
;;
;; Extract several colored identifiers from a form
;; extract* SYMB-L BODY CONT
;; where SYMB-L is the list of symbols to extract, and BODY and CONT
;; has the same meaning as in extract, see below.
;;
;; The extract* macro expands into
;; (K-HEAD (extr-id-l . K-IDL) . K-ARGS)
;; where extr-id-l is the list of extracted colored identifiers. The
;; extraction itself is performed by the macro extract.
(define-syntax extract*
(syntax-rules ()
;; Extract a colored identifier from a form
;; extract SYMB BODY CONT
;; BODY is a form that may contain an occurence of an identifier
;; that refers to the same binding occurrence as SYMB, perhaps
;; with a different color.
;; CONT is a form of the shape (K-HEAD K-IDL . K-ARGS)
;; where K-IDL are K-ARGS are S-expressions representing lists or
;; the empty list.
;; The extract macro expands into
;; (K-HEAD (extr-id . K-IDL) . K-ARGS)
;; where extr-id is the extracted colored identifier. If symbol
;; SYMB does not occur in BODY at all, extr-id is identical to
;; SYMB.
((_ "extract" symb body _cont)
(letrec-syntax
((tr
(syntax-rules (symb)
((_ x symb tail (cont-head symb-l . cont-args))
(cont-head (x . symb-l) . cont-args)) ; symb has occurred
((_ d (x . y) tail cont) ; if body is a composite form,
(tr x x (y . tail) cont)) ; look inside
((_ d1 d2 () (cont-head symb-l . cont-args))
(cont-head (symb . symb-l) . cont-args)) ; symb does not occur
((_ d1 d2 (x . y) cont)
(tr x x y cont)))))
(tr body body () _cont)))
((_ (symb) body cont) ; only one symbol: use extract to do the job
(extract* "extract" symb body cont))
((_ _symbs _body _cont)
(letrec-syntax
((ex-aux ; extract symbol-by-symbol
(syntax-rules ()
((_ found-symbs () body cont)
(reverse () found-symbs cont))
((_ found-symbs (symb . symb-others) body cont)
(extract* "extract" symb body
(ex-aux found-symbs symb-others body cont)))
))
(reverse ; reverse the list of extracted symbols
(syntax-rules () ; to match the order of SYMB-L
((_ res () (cont-head () . cont-args))
(cont-head res . cont-args))
((_ res (x . tail) cont)
(reverse (x . res) tail cont)))))
(ex-aux () _symbs _body _cont)))))
(define-syntax rcv
(syntax-rules ()
((_ (id ...) expr body ...)
(let ((receiver (lambda (id ...) body ...)))
(call-with-current-continuation
(lambda (return)
(call-with-values
(lambda ()
(let-syntax
((rewrite (syntax-rules ()
((_ (*values) *expr)
(let-syntax
((*values (syntax-rules <...> ()
((_ rv <...>)
(return (receiver rv <...>))))))
*expr)))))
(extract* (values) expr (rewrite () expr))) )
;; Note that this works in chicken if we write just
;; receiver
;; instead of the (lambda ...) here (and in the second
;; case too). But R5RS says only continuations captured by call-with-values
;; are safe to be called with multiple values
(lambda (id ...) (receiver id ...)))))))
((_ id expr body ...)
(let ((receiver (lambda id body ...)))
(call-with-current-continuation
(lambda (return)
(call-with-values
(lambda ()
(let-syntax
((rewrite (syntax-rules ()
((_ (*values) *expr)
(let-syntax
((*values (syntax-rules <...> ()
((_ rv <...>)
(return (receiver rv <...>))))))
*expr)))))
(extract* (values) expr (rewrite () expr))) )
;; Let's show that we don't have to have the lambda here; see above.
;;
;; (lambda id (receiver id))
receiver)))))))
;; Examples:
;; Compile time error:
;(rcv (a b c) (values 1 2) (display (cons a b)))
(rcv (a b) (let ((x 1) (a 2)) (values x a)) (cons a b))
(rcv x (values 1 2 3) x)
(define (foo) (values 1 2))
(rcv (a b) (foo) (cons a b))
(define (bar a v) (values a v 1))
;; Runtime error only:
(rcv (a b) (bar 2 3) (cons a b))
(rcv (a b) (rcv (a b c) (values 1 2 3) (values c (cons a b))) (vector b a))
(rcv (a b) (rcv (a b c)
(bar 5 6)
(values c (cons a b)))
(vector b a))
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
