suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

rename metafunction -> template-metafunction

Browse Source
This commit is contained in:
AlexKnauth 2019-02-15 22:14:59 -05:00 committed by Suzanne Soy
parent 121a45f7ed
commit 057bcab015
3 changed files with 36 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
racket/collects/racket/private/prop-template-metafunction.rkt
View File

@ -1,17 +1,17 @@
(module prop-template-metafunction '#%kernel
(#%provide (protect metafunction
prop:metafunction
(rename prop:metafunction? metafunction?)
metafunction-accessor))
(#%provide (protect template-metafunction
prop:template-metafunction
(rename prop:template-metafunction? template-metafunction?)
template-metafunction-accessor))
;; The prop:metafunction structure type property can contain an
;; The prop:template-metafunction structure type property can contain an
;; identifier bound to the run-time metafunction procedure, or the index of a
;; field containing such an identifier.
;; At run-time, when processing the template, the syntax object whose first
;; element is a metafunction identifiers is passed to this metafunction
;; procedure.
(define-values (prop:metafunction-guard)
(define-values (prop:template-metafunction-guard)
(lambda (val struct-type-info-list)
(if (exact-nonnegative-integer? val)
;; Field index, the field must contain an identifier bound to the run-time
@ -27,7 +27,7 @@
#f)
metafunction-internal-id
(raise-argument-error
'prop:metafunction-guard
'prop:template-metafunction-guard
(format (string-append "the value of the ~a-th field should be"
" an identifier")
val)
@ -38,32 +38,37 @@
(λ (_instance) val)
;; Otherwise, raise an error.
(raise-argument-error
'prop:metafunction-guard
'prop:template-metafunction-guard
(string-append "an identifier, or an exact non-negative integer designating"
" a field index within the structure that should contain an"
" identifier.")
val)))))
(define-values (prop:metafunction
prop:metafunction?
metafunction-raw-accessor)
(make-struct-type-property 'metafunction
prop:metafunction-guard))
(define-values (prop:template-metafunction
prop:template-metafunction?
template-metafunction-raw-accessor)
(make-struct-type-property 'template-metafunction
prop:template-metafunction-guard))
(define-values (metafunction-accessor)
(define-values (template-metafunction-accessor)
(lambda (instance . more-args)
(let-values ([(raw) (if (null? more-args) ;; no failure-result given
(metafunction-raw-accessor instance)
(template-metafunction-raw-accessor instance)
(if (null? (cdr more-args))
(let-values ([(failure-result) (car more-args)])
(metafunction-raw-accessor instance failure-result))
(template-metafunction-raw-accessor instance
failure-result))
(error "invalid number of arguments [TODO]")))])
(raw instance))))
;; A default struct type with prop:metafunction.
;; A default struct type with prop:template-metafunction.
;; (struct template-metafunction (proc-id)
;; #:property prop:template-metafunction (struct-field-index proc-id))
(define-values (struct:metafunction metafunction metafunction? metafunction-ref _mf-set!)
(make-struct-type 'syntax-metafunction #f 1 0 #f
(list (cons prop:metafunction 0))
(current-inspector))))
(define-values (_struct:template-metafunction
template-metafunction
_template-metafunction?
_template-metafunction-ref
_mf-set!)
(make-struct-type 'template-metafunction #f 1 0 #f
(list (cons prop:template-metafunction 0))
(current-inspector))))

13
racket/collects/racket/private/template.rkt
View File

@ -13,9 +13,9 @@
datum
~? ~@
~@! signal-absent-pvar
(for-syntax prop:metafunction
metafunction
metafunction?)
(for-syntax prop:template-metafunction
template-metafunction
template-metafunction?)
(protect
(for-syntax attribute-mapping
attribute-mapping?
@ -30,7 +30,8 @@
;; A Template (T) is one of:
;; - pattern-variable
;; - constant (including () and non-pvar identifiers)
;; - (metafunction . T)
;; - (template-metafunction . T)
;; ; or any other structure that implements prop:template-metafunction
;; - (H . T)
;; - (H ... . T), (H ... ... . T), etc
;; - (... T) -- escapes inner ..., ~?, ~@
@ -273,7 +274,7 @@
(unless stx? (wrong-syntax (stx-car t) "metafunctions are not supported"))
(disappeared! (stx-car t))
(define guide (parse-t (stx-cdr t) depth esc?))
`(t-metafun ,(metafunction-accessor mf) ,guide
`(t-metafun ,(template-metafunction-accessor mf) ,guide
(quote-syntax
,(let ([tstx (and (syntax? t) t)])
(datum->syntax tstx (cons (stx-car t) #f) tstx tstx)))))]
@ -495,7 +496,7 @@
;; lookup-metafun : Identifier -> Metafunction/#f
(define (lookup-metafun id)
(define v (syntax-local-value id (lambda () #f)))
(and (metafunction? v) v))
(and (template-metafunction? v) v))
(define (dotted-prefixes id)
(let* ([id-string (symbol->string (syntax-e id))]

5
racket/collects/syntax/parse/experimental/template.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require (for-syntax racket/base)
(only-in racket/private/template
metafunction))
template-metafunction))
(provide (rename-out [syntax template]
[syntax/loc template/loc]
[quasisyntax quasitemplate]
@ -21,7 +21,8 @@
(identifier? #'id)
(with-syntax ([(internal-id) (generate-temporaries #'(id))])
#'(begin (define internal-id (make-hygienic-metafunction expr))
(define-syntax id (metafunction (quote-syntax internal-id)))))]))
(define-syntax id
(template-metafunction (quote-syntax internal-id)))))]))
(define current-template-metafunction-introducer
(make-parameter (lambda (stx) (if (syntax-transforming?) (syntax-local-introduce stx) stx))))