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

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.

private/pure-function.rkt

@@ -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)
+(begin-for-syntax
-  (syntax-parser
+  (define-syntax-class (maybe-free-id=? other)
-    [(self {~optional {~seq {~and fa #:∀} tvars}}
+    #:attributes ()
-           (name . args)
+    (pattern self:id #:when (or (not other)
-           (~optional (~seq C:colon result-type))
+                                (free-identifier=? #'self other))))
-           body …)
+
-     #:with lam (if (free-identifier=? (datum->syntax #'self 'λ) #'te:λ)
+  (define-syntax-class (name+args+body [other-name #f])
-                    #'te:λ
+    (pattern ({~and {~optional {~seq #:∀ tvars}} {~seq fa …}}
-                    #'λ)
+              ({~var name (maybe-free-id=? other-name)} . args)
-     #:with (maybe-result-type …) (if (attribute result-type)
+              . rest)))
-                                      #'(C result-type)
+  (define-syntax-class def
-                                      #'())
+    (pattern {~and d {~or {~literal define}
-     #:with pure/? (if (eq? stateful/stateless-sym 'stateful)
+                          {~literal te:define}}}
-                       #'pure/stateful
+             #:do [(record-disappeared-uses* #'d)])))
-                       #'pure/stateless)
+
-     #:with declared-wrapper (if (eq? stateful/stateless-sym 'stateful)
+(define-for-syntax ((define-pure/impl stateful/stateless-sym) stx)
-                                 #'declared-stateful-pure-function
+  (with-disappeared-uses
-                                 #'declared-stateless-pure-function)
+   (syntax-parse stx
-     (quasisyntax/top-loc this-syntax
+     [{~or (self {~and whole-τ (CT:colon name/τ:id . self-τ)}
-       (define name
+                 (:def . {~var || (name+args+body #'name/τ)}))
-         (declared-wrapper
+           (self . {~and :name+args+body {~not ((:colon . _) . _)}})}
-          (pure/?
+      #:with lam (if (free-identifier=? (datum->syntax #'self 'λ) #'te:λ)
-           (lam #,@(when-attr tvars #'(fa tvars)) args maybe-result-type …
+                     #'te:λ
-                (let () body …))))))]))
+                     #'λ)
+      #: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))

scribblings/delay-pure.scrbl

@@ -105,17 +105,40 @@
 
 @deftogether[
  [@defform*[#:literals (:)
-            [(define-pure/stateless (name . args) body ...)
+            [(define-pure/stateless (name . args) maybe-result body ...)
-             (define-pure/stateless (name . args) : result-type 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) maybe-result body ...)
-             (define-pure/stateful  (name . args) : result-type 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)))

test/test-pure-safe.rkt

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