Centralize the definition of the plambda syntax property.

This commit is contained in:
Eric Dobson 2013-05-25 15:51:23 -07:00
parent 84d3051fee
commit df07151cb9
3 changed files with 20 additions and 11 deletions

View File

@ -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 (:)

View 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))))

View File

@ -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)