suzanne.soy/delay-pure
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed issue with recursive functions defined with define-pure/stateless and define-pure/stateful

Browse Source 
Rhe immutabile-value check was happening before the actual production of the lambda bound to the ID, and therefore an "undefined variable" error was raised.
This commit is contained in:
Georges Dupéron 2017-05-19 04:16:23 +02:00
parent 397260eb13
commit baf7434c7f
3 changed files with 100 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
private/pure-function.rkt
View File

@ -122,7 +122,8 @@
(begin
(free-id-set-add! unsafe-pure-functions-free-id-set/stateless #'fn)
#'(set-box! rw-unsafe-pure-functions-set/stateless
(set-add fn)))]))
(set-add (unbox rw-unsafe-pure-functions-set/stateless)
fn)))]))
(define-for-syntax (unsafe-pure-function?/stateless id)
(free-id-set-member? unsafe-pure-functions-free-id-set/stateless id)))
@ -140,7 +141,8 @@
(begin
(free-id-set-add! unsafe-allowed-functions-free-id-set/stateful #'fn)
#'(set-box! rw-unsafe-allowed-functions-set/stateful
(set-add fn)))]))
(set-add (unbox rw-unsafe-allowed-functions-set/stateful)
fn)))]))
(define-for-syntax (unsafe-allowed-function?/stateful id)
(free-id-set-member? unsafe-allowed-functions-free-id-set/stateful id)))
@ -199,6 +201,8 @@
declared-stateless-pure-function?) x) #t]
[(set-member? built-in-pure-functions-set x) #t]
[(set-member? (unsafe-pure-functions-set/stateless) x) #t]
[(and (eq? stateful/stateless 'stateful)
(set-member? (unsafe-allowed-functions-set/stateful) x)) #t]
;; delay/pure is only used in a safe way, unless the user requires
;; private files
[(eq? x make-promise/pure/stateful) #t]
@ -228,9 +232,9 @@
(define ((immutable/stateless/c varref) x)
(check-immutable! x varref 'stateless void void))
(define-for-syntax (make-no-set!-transformer id)
(define-for-syntax (make-no-set!-transformer id [wrapper #f])
(λ (stx)
(syntax-case stx (set!)
(syntax-case stx ()
[(set-id . rest)
(free-identifier=? #'set-id #'set!)
(raise-syntax-error
@ -240,11 +244,11 @@
(syntax-e id))
stx
#'set-id)]
[self (identifier? #'self) id]
[self (identifier? #'self) (if wrapper #`(#,wrapper #,id) id)]
[(self . args)
(identifier? #'self)
(datum->syntax (syntax-local-identifier-as-binding #'self)
`(,id . ,#'args))])))
`(,(if wrapper #`(#,wrapper #,id) id) . ,#'args))])))
(begin-for-syntax
(define/contract (pure-impl self fn-stx check-result? stateful/stateless-sym)
@ -366,30 +370,57 @@
[(self fn #:check-result) (pure-impl #'self #'fn 'check-result 'stateless)])
)
(define-for-syntax (define-pure/impl stateful/stateless-sym)
(syntax-parser
[(self {~optional {~seq {~and fa #:∀} tvars}}
(name . args)
(~optional (~seq C:colon result-type))
body …)
#:with lam (if (free-identifier=? (datum->syntax #'self 'λ) #'te:λ)
#'te:λ
#'λ)
#:with (maybe-result-type …) (if (attribute result-type)
#'(C result-type)
#'())
#:with pure/? (if (eq? stateful/stateless-sym 'stateful)
#'pure/stateful
#'pure/stateless)
#:with declared-wrapper (if (eq? stateful/stateless-sym 'stateful)
#'declared-stateful-pure-function
#'declared-stateless-pure-function)
(quasisyntax/top-loc this-syntax
(define name
(declared-wrapper
(pure/?
(lam #,@(when-attr tvars #'(fa tvars)) args maybe-result-type …
(let () body …))))))]))
(begin-for-syntax
(define-syntax-class (maybe-free-id=? other)
#:attributes ()
(pattern self:id #:when (or (not other)
(free-identifier=? #'self other))))
(define-syntax-class (name+args+body [other-name #f])
(pattern ({~and {~optional {~seq #:∀ tvars}} {~seq fa …}}
({~var name (maybe-free-id=? other-name)} . args)
. rest)))
(define-syntax-class def
(pattern {~and d {~or {~literal define}
{~literal te:define}}}
#:do [(record-disappeared-uses* #'d)])))
(define-for-syntax ((define-pure/impl stateful/stateless-sym) stx)
(with-disappeared-uses
(syntax-parse stx
[{~or (self {~and whole-τ (CT:colon name/τ:id . self-τ)}
(:def . {~var || (name+args+body #'name/τ)}))
(self . {~and :name+args+body {~not ((:colon . _) . _)}})}
#:with lam (if (free-identifier=? (datum->syntax #'self 'λ) #'te:λ)
#'te:λ
#'λ)
#:with pure/? (if (eq? stateful/stateless-sym 'stateful)
#'pure/stateful
#'pure/stateless)
#:with declared-wrapper (if (eq? stateful/stateless-sym 'stateful)
#'declared-stateful-pure-function
#'declared-stateless-pure-function)
#:with unsafe-free-id-set
(if (eq? stateful/stateless-sym 'stateful)
#'unsafe-allowed-functions-free-id-set/stateful
#'unsafe-pure-functions-free-id-set/stateless)
#:with name-impl ((make-syntax-introducer) #'name)
(quasisyntax/top-loc this-syntax
(begin
#,@(when-attr CT #'{(CT name-impl . self-τ)})
;#,@(when-attr whole-τ #'{whole-τ})
(define-syntax name (make-no-set!-transformer #'name-impl))
(define name-impl
(declared-wrapper
(pure/?
(lam fa … args . rest))))
(define-syntax dummy
;; Must happen after defining name-impl, so that the fresh
;; definition is visible. Due to the way Racket handle intdef-ctx
;; it will first run all the macro definitions, and then expand the
;; contents of name-impl (so when expanding the pure/? code,
;; the free-id-set will already be modified.
(free-id-set-add! unsafe-free-id-set #'name-impl))))])))
(define-syntax define-pure/stateful (define-pure/impl 'stateful))
(define-syntax define-pure/stateless (define-pure/impl 'stateless))

33
scribblings/delay-pure.scrbl
View File

@ -105,17 +105,40 @@
@deftogether[
[@defform*[#:literals (:)
[(define-pure/stateless (name . args) body ...)
(define-pure/stateless (name . args) : result-type body ...)]]
[(define-pure/stateless (name . args) maybe-result body ...)
(define-pure/stateless
(: name . type)
(define (name . args) maybe-result body ...))]]
@defform*[#:literals (:)
[(define-pure/stateful (name . args) body ...)
(define-pure/stateful (name . args) : result-type body ...)]]]]{
[(define-pure/stateful (name . args) maybe-result body ...)
(define-pure/stateful
(: name . type)
(define (name . args) maybe-result body ...))]
#:grammar
[(maybe-result (code:line)
(code:line : result-type))]]]]{
Defines @racket[name] as a pure function. The @racket[define-pure/stateful]
form relies on @racket[pure/stateful], and therefore allows the function to
return a value containing @tech{stateful} functions. On the other hand,
@racket[define-pure/stateless] relies on @racket[pure/stateless], and
therefore only allows the return value to contain @tech{stateless} functions.}
therefore only allows the return value to contain @tech{stateless} functions.
Due to the way the function is defined, a regular separate type annotation of
the form @racket[(: name type)] would not work (the function is first defined
using a temporary variable, and @racket[name] is merely a
@tech["rename transformer"
#:doc '(lib "scribblings/reference/reference.scrbl")] for that temporary
variable).
It is therefore possible to express such a type annotation by placing both
the type annotation and the definition within a @racket[define-pure/stateless]
or @racket[define-pure/stateful] form:
@racketblock[
(define-pure/stateless
(: square : (→ Number Number))
(define (square x) (* x x)))]}
@(define-syntax (show-pure-ids stx)
(with-syntax ([(id ...) (map (λ (id) (datum->syntax #'here (syntax-e id)))

21
test/test-pure-safe.rkt
View File

@ -16,16 +16,17 @@
(define f0
(let ([x (vector-immutable 'a 'b 'c)])
(let ()
(: f (→ Integer
(Listof Integer)
(Rec R (List* Integer Symbol (Promise R)))))
(define-pure/stateless (f [n : Integer] [big : (Listof Integer)])
: (Rec R (List* Integer Symbol (Promise R)))
(cons (length big)
(cons (vector-ref x (modulo n 3))
(delay/pure/stateless (f (add1 n)
(reverse (cons (length big)
big)))))))
(define-pure/stateless
(: f (→ Integer
(Listof Integer)
(Rec R (List* Integer Symbol (Promise R)))))
(define (f [n : Integer] [big : (Listof Integer)])
: (Rec R (List* Integer Symbol (Promise R)))
(cons (length big)
(cons (vector-ref x (modulo n 3))
(delay/pure/stateless (f (add1 n)
(reverse (cons (length big)
big))))))))
(f 0 '()))))
;; Check that the first 100 elements are as expected: