define-extend - extend procedure definitions

[camoy]

Suppose we're writing interpreters interp0 and interp1 for languages L0 and L1 respectively. L0 has numbers and binary addition, and L1 extends L0 with binary multiplication. Goal. Write interp1 without copying all the cases from interp0.

Example Before

One solution is to write the interpreters in open-recursive style. Instead of recurring directly, recursive calls occur indirectly through an extra parameter. An interpreter can be invoked by closing the recursion using a fixed-point combinator.

(define fix
  (λ (f)
    ((λ (x) (f (λ (g) ((x x) g))))
     (λ (x) (f (λ (g) ((x x) g)))))))

(define ((interp0 recur) e)
  (match e
    [`(+ ,x ,y) (+ (recur x) (recur y))]
    [(? number?) e]))

((fix interp0) '(+ (+ 1 2) (+ 5 6))) ; 14

(define ((interp1 recur) e)
  (match e
    [`(* ,x ,y) (* (recur x) (recur y))]
    [_ ((interp0 recur) e)]))

((fix interp1) '(+ (+ 1 2) (* 5 6))) ; 33

Example After

The define-extend macro allows you to write extensible procedures in a more natural style.

(define-extend (interp0 e)
  (match e
    [`(+ ,x ,y) (+ (interp0 x) (interp0 y))]
    [(? number?) e]))

(interp0 '(+ (+ 1 2) (+ 5 6))) ; 14

(define-extend (interp1 e)
  #:extend interp0
  (match e
    [`(* ,x ,y) (* (interp1 x) (interp1 y))]
    [_ (interp0 e)]))

(interp1 '(+ (+ 1 2) (* 5 6))) ; 33

This macro supports some static checking. If the procedure we're extending wasn't defined using define-extend, then we get a compile-time error.

(define-extend (interp1 e)
  #:extend map
  ...)

;; define-extend: expected an extensible procedure
;;   at: map

Macro

(require (for-syntax syntax/parse
                     syntax/parse/lib/function-header))

(begin-for-syntax
  (struct extensible (closed-id open-id)
    #:property prop:rename-transformer 0)

  (define-splicing-syntax-class extend-option
    #:attributes (parent-id open-id)
    (pattern (~seq #:extend parent-id:id)
             #:do [(define-values (parent-ext _)
                     (syntax-local-value/immediate #'parent-id
                                                   (λ () (values #f #f))))]
             #:fail-when (and (not (extensible? parent-ext)) #'parent-id)
             "expected an extensible procedure"
             #:attr open-id (extensible-open-id parent-ext))
    (pattern (~seq)
             #:attr parent-id #f
             #:attr open-id #f)))

(define-syntax (define-extend stx)
  (syntax-parse stx
    [(_ (?name:id . ?fmls:formals) ?ext:extend-option ?body:expr ...+)
     #:with (?closed ?open) (generate-temporaries #'(?name ?name))
     #:with ?proc
     (syntax/loc stx
       (~? (λ ?fmls
             (let ([?ext.parent-id (?ext.open-id ?name)])
               ?body ...))
           (λ ?fmls ?body ...)))
     #'(begin
         (define ?closed
           (letrec ([?name ?proc])
             ?name))
         (define (?open ?name) ?proc)
         (define-syntax ?name
           (extensible #'?closed #'?open)))]))

For a valid input, define-extend generates two variants of the procedure: a closed version and an open version. It then creates a transformer binding that records the name of both these variants in an extensible struct. This struct has prop:rename-transformer so that calling the procedure defaults to the closed variant.

When defining an extension of procedure f, we make sure to shadow the binding of f within the body of the extension so as to close it off appropriately. We use the extensible struct (found by syntax-local-value/immediate) to get the identifier of the open version of f.

License

MIT License and CC BY 4.0