From 0c1b71bf3271713063aad957a3439b2cff8a95f2 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Wed, 15 Jun 2016 01:12:19 -0400 Subject: [PATCH] Lift out definition table lookup for init-envs --- typed-racket-lib/typed-racket/env/init-envs.rkt | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/typed-racket-lib/typed-racket/env/init-envs.rkt b/typed-racket-lib/typed-racket/env/init-envs.rkt index 0f9b149c..1c919c0a 100644 --- a/typed-racket-lib/typed-racket/env/init-envs.rkt +++ b/typed-racket-lib/typed-racket/env/init-envs.rkt @@ -84,6 +84,13 @@ (or (> depth 10) (> width 10))) +(define-match-expander In-Predefined-Table: + (λ (stx) + (syntax-parse stx + [(_ id) + #'(? Rep? (app (λ (v) (hash-ref predefined-type-table (Rep-seq v) #f)) + (? values id)))]))) + ;; Helper for type->sexp (define (recur ty) (define (numeric? t) (match t [(Base: _ _ _ b) b] [(Value: (? number?)) #t] [_ #f])) @@ -99,7 +106,7 @@ ,(type->sexp (apply Un others)))])) (match ty - [(? Rep? (app (lambda (v) (hash-ref predefined-type-table (Rep-seq v) #f)) (? values id))) id] + [(In-Predefined-Table: id) id] [(Base: n cnt pred _) (int-err "Base type ~a not in predefined-type-table" n)] [(B: nat) `(make-B ,nat)] @@ -295,7 +302,7 @@ ;; Convert a prop to an s-expression (define (prop->sexp prop) (match prop - [(? Rep? (app (lambda (v) (hash-ref predefined-type-table (Rep-seq v) #f)) (? values id))) id] + [(In-Predefined-Table: id) id] ;; TrueProp/FalseProp are predefined [(TypeProp: o t) `(make-TypeProp ,(object->sexp o) ,(type->sexp t))] @@ -327,10 +334,8 @@ ;; Convert a path element in an object to an s-expression (define (path-elem->sexp pe) (match pe - [(CarPE:) `(make-CarPE)] - [(CdrPE:) `(make-CdrPE)] - [(SyntaxPE:) `(make-SyntaxPE)] - [(ForcePE:) `(make-ForcePE)] + [(In-Predefined-Table: id) id] + ;; CarPE, CdrPE, SyntaxPE, ForcePE are in the table [(StructPE: ty idx) `(make-StructPE ,(type->sexp ty) ,idx)] [(FieldPE:) `(make-FieldPE)]))