PasteRack.org
Paste # 82158
2018-02-19 12:05:12

Fork as a new paste.

Paste viewed 199 times.


Embed:

optional-argument protocol example

(define (f x [y #t] #:q q #:z [z (box y)])
  (list x y q z))

;;  expands to core functions:

   (define-values
    (f7)
    ;; direct uses expands to direct call to here
    (lambda (q1 z2 x6 y5)
      (let-values (((x) x6))
        (let-values (((y) y5))
          (let-values (((q) q1))
            (let-values (((z)
                          (if (#%app eq? z2 unsafe-undefined)
                            (#%app box y)
                            z2)))
              (let-values () (#%app list x y q z))))))))

   (define-values
    (unpack8)
    (lambda (given-kws given-args x6 y5)
      (let-values (((q1) (#%app car given-args))
                   ((given-kws) (#%app cdr given-kws))
                   ((given-args) (#%app cdr given-args)))
        (let-values (((z4) (#%app pair? given-kws)))
          (let-values (((z2) (if z4 (#%app car given-args) unsafe-undefined)))
            (#%app f7 q1 z2 x6 y5))))))

   (define-values
    (f9)
    (#%app
     lifted.1 ; = `make-keyword-procedure`, but with a name
     (lambda (given-kws given-argc)
       (if (if (#%app >= given-argc '3) (#%app <= given-argc '4) '#f)
         (#%app subsets? '(#:q) given-kws '(#:q #:z))
         '#f))
     (case-lambda
      ((given-kws given-args x) (#%app unpack8 given-kws given-args x '#t))
      ((given-kws given-args x y5) (#%app unpack8 given-kws given-args x y5)))
     '(#:q)
     '(#:q #:z)))