Thanks to visit codestin.com
Credit goes to github.com

Skip to content

define-extend - extend procedure definitions #13

@camoy

Description

@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

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions