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

Reduce for-template imports in environment code.

Browse Source
This commit is contained in:
Eric Dobson 2013-11-16 12:14:23 -08:00
parent 4537b52b6a
commit 7a31c966c8
3 changed files with 17 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/for-clauses.rkt
View File

@ -1,8 +1,8 @@
#lang racket/base #lang racket/base
(require syntax/parse (require syntax/parse
"annotate-classes.rkt" (for-template (only-in racket/base quote))
(for-template racket/base)) "annotate-classes.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
@ -13,7 +13,7 @@
(pattern (~and c (var:optionally-annotated-name seq-expr:expr)) (pattern (~and c (var:optionally-annotated-name seq-expr:expr))
#:with (expand ...) #`(#,(syntax/loc #'c #:with (expand ...) #`(#,(syntax/loc #'c
(var.ann-name seq-expr))) (var.ann-name seq-expr)))
#:with (expand* ...) #'(expand ... #:when #t)) #:with (expand* ...) #'(expand ... #:when '#t))
;; multi-valued seq-expr ;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker ;; currently disabled because it triggers an internal error in the typechecker
;; (pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr)) ;; (pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr))

30
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt vendored
View File

@ -8,12 +8,8 @@
"type-name-env.rkt" "type-name-env.rkt"
"type-alias-env.rkt" "type-alias-env.rkt"
"mvar-env.rkt" "mvar-env.rkt"
(rename-in racket/private/sort [sort raw-sort]) (rename-in racket/private/sort [sort raw-sort])
(rep type-rep object-rep filter-rep rep-utils free-variance) (rep type-rep object-rep filter-rep rep-utils free-variance)
(for-template (rep type-rep object-rep filter-rep)
(types union abbrev)
racket/shared (except-in racket/base sort)
(rename-in racket/private/sort [sort raw-sort]))
(for-syntax syntax/parse racket/base) (for-syntax syntax/parse racket/base)
(types abbrev union) (types abbrev union)
racket/syntax racket/dict racket/list racket/syntax racket/dict racket/list
@ -51,12 +47,12 @@
(define (split-union ts) (define (split-union ts)
(define-values (nums others) (partition numeric? ts)) (define-values (nums others) (partition numeric? ts))
(cond [(or (null? nums) (null? others)) (cond [(or (null? nums) (null? others))
;; nothing interesting to do in this case ;; nothing interesting to do in this case
`(make-Union (,#'raw-sort (list ,@(map sub ts)) < Type-seq #f))] `(make-Union (,#'raw-sort (list ,@(map sub ts)) < Type-seq #f))]
[else [else
;; we do a little more work to hopefully save a bunch in serialization space ;; we do a little more work to hopefully save a bunch in serialization space
;; if we get a hit in the predefined-type-table ;; if we get a hit in the predefined-type-table
`(simple-Un ,(sub (apply Un nums)) ,(sub (apply Un others)))])) `(simple-Un ,(sub (apply Un nums)) ,(sub (apply Un others)))]))
(define (gen-constructor sym) (define (gen-constructor sym)
(string->symbol (string-append "make-" (substring (symbol->string sym) 7)))) (string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
@ -69,14 +65,14 @@
[(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) #f #f '()))) [(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) #f #f '())))
`(simple-> (list ,@(map sub dom)) ,(sub t))] `(simple-> (list ,@(map sub dom)) ,(sub t))]
[(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (TypeFilter: ft pth n) [(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (TypeFilter: ft pth n)
(NotTypeFilter: ft pth n)) (NotTypeFilter: ft pth n))
(Empty:)))) (Empty:))))
#f #f '()))) #f #f '())))
`(make-pred-ty (list ,@(map sub dom)) ,(sub t) ,(sub ft) ,(sub n) ,(sub pth))] `(make-pred-ty (list ,@(map sub dom)) ,(sub t) ,(sub ft) ,(sub n) ,(sub pth))]
[(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (NotTypeFilter: (== -False) pth 0) [(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (NotTypeFilter: (== -False) pth 0)
(TypeFilter: (== -False) pth 0)) (TypeFilter: (== -False) pth 0))
(Path: pth 0)))) (Path: pth 0))))
#f #f '()))) #f #f '())))
`(->acc (list ,@(map sub dom)) ,(sub t) ,(sub pth))] `(->acc (list ,@(map sub dom)) ,(sub t) ,(sub pth))]
[(Union: elems) (split-union elems)] [(Union: elems) (split-union elems)]
[(Base: n cnt pred _) (int-err "Base type not in predefined-type-table" n)] [(Base: n cnt pred _) (int-err "Base type not in predefined-type-table" n)]

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/scoped-tvar-env.rkt vendored
View File

@ -3,7 +3,6 @@
;; Maintain mapping of type variables introduced by literal Alls in type annotations. ;; Maintain mapping of type variables introduced by literal Alls in type annotations.
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
(for-template racket/base)
(private syntax-properties) (private syntax-properties)
syntax/parse syntax/parse
syntax/id-table syntax/id-table
@ -28,7 +27,7 @@
(hash-update! tvar-stx-mapping stx (lambda (old-vars) (cons vars old-vars)) null)) (hash-update! tvar-stx-mapping stx (lambda (old-vars) (cons vars old-vars)) null))
(let loop ((stx stx)) (let loop ((stx stx))
(syntax-parse stx (syntax-parse stx
#:literals (#%expression #%plain-lambda let-values case-lambda) #:literal-sets (kernel-literals)
[(#%expression e) (loop #'e)] [(#%expression e) (loop #'e)]
[(~or (case-lambda formals . body) (#%plain-lambda formals . body)) [(~or (case-lambda formals . body) (#%plain-lambda formals . body))
(add-vars stx)] (add-vars stx)]