(declare (extended-bindings) (not constant-fold) (not safe))

(declare (block) (inlining-limit 0))
(declare (debug))
#;
(univ-define-prim "##make-subprocedure" #f
  (make-translated-operand-generator
   (lambda (ctx return arg1 arg2)
     (univ-call-with-fn-attrib
      ctx
      arg1
      "subprocedures"
      (lambda (subprocs)
        (return (^array-index subprocs (^fixnum-unbox arg2))))))))

(define (foo)
  (lambda (x) (##fx+ x x)))

(define f (foo))

(define (make-adder x)
  (lambda (y) (##fx+ y x)))

(define add1 (make-adder 1))

(println (##eq? foo (##subprocedure-parent foo)))
(println (##eq? foo (##subprocedure-parent f)))
(println (##eq? make-adder (##subprocedure-parent make-adder)))
(println (##eq? make-adder (##subprocedure-parent (##closure-code add1))))

#;
(println (##eq? foo
                (##make-subprocedure
                 foo
                 (##subprocedure-id foo))))
#;
(println (##eq? f
                (##make-subprocedure
                 foo
                 (##subprocedure-id f))))


;(println (##subprocedure-id foo))
;(println (##subprocedure-id make-adder))
;(println (##subprocedure-id (##closure-code add1)))

;(println (##subprocedure-nb-parameters foo))
;(println (##subprocedure-nb-parameters make-adder))
;(println (##subprocedure-nb-parameters (##closure-code add1)))

(println (##subprocedure-nb-closed foo))
(println (##subprocedure-nb-closed make-adder))
(println (##subprocedure-nb-closed (##closure-code add1)))

(println (##subprocedure-parent-name foo))
(println (##subprocedure-parent-name make-adder))
(println (##subprocedure-parent-name (##closure-code add1)))

;(pp (##subprocedure-parent-info foo))
;(pp (##subprocedure-parent-info make-adder))
;(pp (##subprocedure-parent-info (##closure-code add1)))
