Вы можете сделать это, определив собственную версию define, которая сохраняет выражение во время компиляции, которое replace-plus-with-mul может получить позже.
Два макроса define/replacable и replace-plus-with-mul имеютчтобы работать вместе, используя define-syntax и syntax-local-value:
define/replacable использует define-syntax, чтобы связать compile-информация о времени с идентификатором, который он определяет. replace-plus-with-mul использует syntax-local-value для поиска этой информации времени компиляции.
Первый проход, сохранениеФункция непосредственно в define-syntax
#lang racket
(require syntax/parse/define
(for-syntax syntax/transformer))
(define-syntax-parser define/replacable
[(_ name:id expr:expr)
#:with plus (datum->syntax #'name 'plus)
#:with mul (datum->syntax #'name 'mul)
#'(define-syntax name
;; Identifier Identifier -> Expression
;; Replaces plus and mul within the expr
;; with the two new identifiers passed to
;; the function
(lambda (plus mul)
(with-syntax ([plus plus] [mul mul])
#'expr)))])
(define-syntax-parser replace-plus-with-mul
[(_ name:id replacable:id)
(define replace (syntax-local-value #'replacable))
#`(define name #,(replace #'mul #'mul))])
С этими определениями эта программа работает:
(define plus (lambda (x y) (+ x y)))
(define mul (lambda (x y) (* x y)))
(define a 4)
(define b 2)
(define/replacable c (plus a b))
(replace-plus-with-mul d c) ;; (define d (mul a b))
(print d)
;=output> 8
Однако c в этом примере не может использоваться как нормальное выражение.Его можно использовать в replace-plus-with-mul, но только в этом.Это можно исправить, добавив структуру.
Second Pass, сохранив структуру, чтобы обычные пользователи также работали
В первой версии два макроса взаимодействовали следующим образом:
define/replacable использует define-syntax, чтобы связать информацию времени компиляции с идентификатором, который он определяет. replace-plus-with-mul использует syntax-local-value для просмотрадо этой информации времени компиляции.
Однако, это не позволяет идентификаторам вести себя нормально.Для этого нам нужно что-то вроде этого:
define/replacable использует define-syntax, чтобы связать идентификатор, который он определяет, со структурой времени компиляции, которая содержит оба: - нормальное поведение
- заменить поведение
replace-plus-with-mul использует syntax-local-value для поиска этой структуры времени компиляции и полученияreplace поведение вне его - Обычный макроэкспандер Racket использует
syntax-local-value для поиска этой структуры времени компиляции и использует ее как процедуру для применения в качестве макроса.Из-за этого мы должны сделать структуру #:property prop:procedure с нормальным поведением.
Эта структура может выглядеть следующим образом:
(begin-for-syntax
;; normal : Expression -> Expression
;; replace : Identifier Identifier -> Expression
(struct replacable-id [normal replace]
#:property prop:procedure (struct-field-index normal)))
Теперьмакрос define/replacable должен генерировать define-syntax, который создает один из них:
(define-syntax name
(replacable-id ???
(lambda (plus mul)
...what-we-had-before...)))
Если мы хотим, чтобы нормальное поведение выглядело как переменная, мы можем заполнить ??? отверстие, используя make-variable-like-transformer из syntax/transformer:
(require (for-syntax syntax/transformer))
(begin-for-syntax
;; Identifier -> [Expression -> Expression]
(define (make-var-like-transformer id)
(set!-transformer-procedure (make-variable-like-transformer id))))
Тогда define/replacable может сгенерировать что-то вроде этого:
(define normal-name expr)
(define-syntax name
(replacable-id (make-var-like-transformer #'normal-name)
(lambda (plus mul)
...what-we-had-before...)))
Собрав все вместе:
#lang racket
(require syntax/parse/define
(for-syntax syntax/transformer))
(begin-for-syntax
;; Identifier -> [Expression -> Expression]
(define (make-var-like-transformer id)
(set!-transformer-procedure (make-variable-like-transformer id)))
;; normal : Expression -> Expression
;; replace : Identifier Identifier -> Expression
(struct replacable-id [normal replace]
#:property prop:procedure (struct-field-index normal)))
(define-syntax-parser define/replacable
[(_ name:id expr:expr)
#:with plus (datum->syntax #'name 'plus)
#:with mul (datum->syntax #'name 'mul)
#'(begin
(define normal-name expr)
(define-syntax name
(replacable-id (make-var-like-transformer #'normal-name)
(lambda (plus mul)
(with-syntax ([plus plus] [mul mul])
#'expr)))))])
(define-syntax-parser replace-plus-with-mul
[(_ name:id replacable:id)
(define value (syntax-local-value #'replacable))
(define replace (replacable-id-replace value))
#`(define name #,(replace #'mul #'mul))])
И пробуем:
(define plus (lambda (x y) (+ x y)))
(define mul (lambda (x y) (* x y)))
(define/replacable a 4)
(define/replacable b 2)
(define/replacable c (plus a b))
(replace-plus-with-mul d c) ;; (define d (mul a b))
(print d)
;=output> 8