Centralize the definition of the plambda syntax property.
This commit is contained in:
parent
84d3051fee
commit
df07151cb9
|
@ -57,6 +57,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
"annotate-classes.rkt"
|
"annotate-classes.rkt"
|
||||||
"internal.rkt"
|
"internal.rkt"
|
||||||
"../utils/tc-utils.rkt"
|
"../utils/tc-utils.rkt"
|
||||||
|
"../private/syntax-properties.rkt"
|
||||||
"../types/utils.rkt"
|
"../types/utils.rkt"
|
||||||
"for-clauses.rkt")
|
"for-clauses.rkt")
|
||||||
"../types/numeric-predicates.rkt"
|
"../types/numeric-predicates.rkt"
|
||||||
|
@ -318,9 +319,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
"duplicate type variable declaration"
|
"duplicate type variable declaration"
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(#%expression
|
(#%expression
|
||||||
#,(syntax-property (syntax/loc stx (lambda: formals . body))
|
#,(plambda-property (syntax/loc stx (lambda: formals . body))
|
||||||
'typechecker:plambda
|
#'(tvars ...))))]))
|
||||||
#'(tvars ...))))]))
|
|
||||||
|
|
||||||
(define-syntax (pcase-lambda: stx)
|
(define-syntax (pcase-lambda: stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -329,9 +329,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
"duplicate type variable declaration"
|
"duplicate type variable declaration"
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(#%expression
|
(#%expression
|
||||||
#,(syntax-property (syntax/loc stx (case-lambda: cl ...))
|
#,(plambda-property (syntax/loc stx (case-lambda: cl ...))
|
||||||
'typechecker:plambda
|
#'(tvars ...))))]))
|
||||||
#'(tvars ...))))]))
|
|
||||||
|
|
||||||
(define-syntax (popt-lambda: stx)
|
(define-syntax (popt-lambda: stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -340,9 +339,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
"duplicate type variable declaration"
|
"duplicate type variable declaration"
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(#%expression
|
(#%expression
|
||||||
#,(syntax-property (syntax/loc stx (opt-lambda: formals . body))
|
#,(plambda-property (syntax/loc stx (opt-lambda: formals . body))
|
||||||
'typechecker:plambda
|
#'(tvars ...))))]))
|
||||||
#'(tvars ...))))]))
|
|
||||||
|
|
||||||
(define-syntax (pdefine: stx)
|
(define-syntax (pdefine: stx)
|
||||||
(syntax-parse stx #:literals (:)
|
(syntax-parse stx #:literals (:)
|
||||||
|
|
11
collects/typed-racket/private/syntax-properties.rkt
Normal file
11
collects/typed-racket/private/syntax-properties.rkt
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide plambda-property)
|
||||||
|
|
||||||
|
;; TODO: make this an uninterned symbol once the phasing issue of the unit
|
||||||
|
;; tests is fixed
|
||||||
|
(define plambda-symbol 'typechecker:plambda)
|
||||||
|
(define plambda-property
|
||||||
|
(case-lambda
|
||||||
|
((stx) (syntax-property stx plambda-symbol))
|
||||||
|
((stx value) (syntax-property stx plambda-symbol value))))
|
|
@ -7,7 +7,7 @@
|
||||||
(except-in (rep type-rep) make-arr)
|
(except-in (rep type-rep) make-arr)
|
||||||
(rename-in (except-in (types abbrev utils union) -> ->* one-of/c)
|
(rename-in (except-in (types abbrev utils union) -> ->* one-of/c)
|
||||||
[make-arr* make-arr])
|
[make-arr* make-arr])
|
||||||
(private type-annotation)
|
(private type-annotation syntax-properties)
|
||||||
(typecheck signatures tc-metafunctions tc-subst check-below)
|
(typecheck signatures tc-metafunctions tc-subst check-below)
|
||||||
(env type-env-structs lexical-env tvar-env index-env scoped-tvar-env)
|
(env type-env-structs lexical-env tvar-env index-env scoped-tvar-env)
|
||||||
(utils tc-utils)
|
(utils tc-utils)
|
||||||
|
@ -325,7 +325,7 @@
|
||||||
expected))))
|
expected))))
|
||||||
|
|
||||||
(define (plambda-prop stx)
|
(define (plambda-prop stx)
|
||||||
(define d (syntax-property stx 'typechecker:plambda))
|
(define d (plambda-property stx))
|
||||||
(and d (car (flatten d))))
|
(and d (car (flatten d))))
|
||||||
|
|
||||||
(define (has-poly-annotation? form)
|
(define (has-poly-annotation? form)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user