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
(require syntax/parse
"annotate-classes.rkt"
(for-template racket/base))
(for-template (only-in racket/base quote))
"annotate-classes.rkt")
(provide (all-defined-out))
@ -13,7 +13,7 @@
(pattern (~and c (var:optionally-annotated-name seq-expr:expr))
#:with (expand ...) #`(#,(syntax/loc #'c
(var.ann-name seq-expr)))
#:with (expand* ...) #'(expand ... #:when #t))
#:with (expand* ...) #'(expand ... #:when '#t))
;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker
;; (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-alias-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)
(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)
(types abbrev union)
racket/syntax racket/dict racket/list
@ -51,12 +47,12 @@
(define (split-union ts)
(define-values (nums others) (partition numeric? ts))
(cond [(or (null? nums) (null? others))
;; nothing interesting to do in this case
`(make-Union (,#'raw-sort (list ,@(map sub ts)) < Type-seq #f))]
[else
;; we do a little more work to hopefully save a bunch in serialization space
;; if we get a hit in the predefined-type-table
`(simple-Un ,(sub (apply Un nums)) ,(sub (apply Un others)))]))
;; nothing interesting to do in this case
`(make-Union (,#'raw-sort (list ,@(map sub ts)) < Type-seq #f))]
[else
;; we do a little more work to hopefully save a bunch in serialization space
;; if we get a hit in the predefined-type-table
`(simple-Un ,(sub (apply Un nums)) ,(sub (apply Un others)))]))
(define (gen-constructor sym)
(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 '())))
`(simple-> (list ,@(map sub dom)) ,(sub t))]
[(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (TypeFilter: ft pth n)
(NotTypeFilter: ft pth n))
(Empty:))))
#f #f '())))
(NotTypeFilter: ft pth n))
(Empty:))))
#f #f '())))
`(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)
(TypeFilter: (== -False) pth 0))
(Path: pth 0))))
#f #f '())))
(TypeFilter: (== -False) pth 0))
(Path: pth 0))))
#f #f '())))
`(->acc (list ,@(map sub dom)) ,(sub t) ,(sub pth))]
[(Union: elems) (split-union elems)]
[(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.
(require "../utils/utils.rkt"
(for-template racket/base)
(private syntax-properties)
syntax/parse
syntax/id-table
@ -28,7 +27,7 @@
(hash-update! tvar-stx-mapping stx (lambda (old-vars) (cons vars old-vars)) null))
(let loop ((stx stx))
(syntax-parse stx
#:literals (#%expression #%plain-lambda let-values case-lambda)
#:literal-sets (kernel-literals)
[(#%expression e) (loop #'e)]
[(~or (case-lambda formals . body) (#%plain-lambda formals . body))
(add-vars stx)]