Permalink
Browse files

new representation scheme for typed racket internals

This is a major to some of the internal representation of things
within Typed Racket (mostly affecting structs that inherited from Rep
(see rep/rep-utils.rkt)), and lots of tweaks and bug fixes that
happened along the way.

This PR includes the following major changes:

A new rep-utils implementation, which uses struct properties for the
generic operations and properties of the various Reps (see
rep-utils.rkt)

More specific Rep inheritance (i.e. arr no longer inherits from Type,
because it is not a Type, etc ...) (see type-rep.rkt, core-rep.rkt,
values-rep.rkt), and thus things like Type/c no longer exist

New Rep's to classify the things that are no longer Type or Prop,
(such as PropSets, SomeValues, Results, etc -- see core-rep.rkt and
values-rep.rkt)

uses of type-case now replaced by uses of Rep-fold and Rep-walk

structural types can specify their fields' variance and operations
like subtyping and free-vars can generically operate over these types
(see type-rep.rkt)

type-mask replaces types key -- types masks are described in detail in
(rep/type-mask.rkt)

Types can specify a predicate to recognize their "top type" via [#:top
pred])

There is an explicit 'Bottom' type now (i.e. neither union or
intersection are used)

subtyping re-organized, slight tweaking to inference

various environments got for-each functions in addition to the map
functions they had (e.g. type-name-env.rkt)

Empty is no longer an Object? -- the OptObject? predicate checks for
either Object or Empty, and so it is easier to be clear about where
Empty makes sense appearing and where it does not

Previously signatures were created with promises in their fields, now
we create a promise around each signature (this way the contracts for
Signature fields are cleaner)

Names for structs now use the args field to describe how many type
arguments they take (Note: this could use further tidying for sure!)

simplified the propositional logic code in several places, got rid of
escape continuations, etc (see prop-ops.rkt, tc-envops.rkt,
tc-metafunctions.rkt)

we now use subsumption more to simplify type results from type
checking, e.g. if the type does not overlap w/ false, it's false
proposition is FalseProp, etc (see tc-expr-unit.rkt and prop-ops.rkt,
the function is called reduce-tc-results/subsumption)

updating along a path will now intersect with the expected structural
type if it is not encountered (e.g. updating Any with (Int @ car) now
produces (Pairof Int Any) instead of Any -- see update.rkt)

lots of tests were tweaked to match up w/ the new prop subsumption
that occurs

remove was renamed subtract (so as to not conflict w/ racket/base's
remove)

a restrict function was added, which acts like intersect but is never
additive (i.e. it will never create an intersection if it can't figure
out how the two types relate -- see intersect.rkt)

tc-subst was modified to substitute out all the variables leaving
scope at once (and I simplified/tweaked some of the logic in there a
little, see tc-subst.rkt)

Type checking function applications now propagates information learned
why type checking the arguments, (e.g. (begin (f (assert x boolean?))
...)) ; the remainder of the begin is aware that x is a boolean)
  • Loading branch information...
Andrew Kent authored and pnwamk committed Sep 9, 2016
1 parent efecd24 commit 24c64e9de06b25291ca685ae954e6bed58583326
Showing with 5,140 additions and 4,245 deletions.
  1. +1 −3 typed-racket-lib/typed-racket/base-env/ann-inst.rkt
  2. +1 −1 typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt
  3. +1 −1 typed-racket-lib/typed-racket/base-env/base-env.rkt
  4. +4 −4 typed-racket-lib/typed-racket/base-env/top-interaction.rkt
  5. +0 −1 typed-racket-lib/typed-racket/core.rkt
  6. +6 −2 typed-racket-lib/typed-racket/env/env-utils.rkt
  7. +8 −4 typed-racket-lib/typed-racket/env/global-env.rkt
  8. +26 −22 typed-racket-lib/typed-racket/env/init-envs.rkt
  9. +6 −31 typed-racket-lib/typed-racket/env/lexical-env.rkt
  10. +9 −17 typed-racket-lib/typed-racket/env/signature-env.rkt
  11. +27 −30 typed-racket-lib/typed-racket/env/signature-helper.rkt
  12. +7 −1 typed-racket-lib/typed-racket/env/type-alias-env.rkt
  13. +5 −5 typed-racket-lib/typed-racket/env/type-env-structs.rkt
  14. +15 −5 typed-racket-lib/typed-racket/env/type-name-env.rkt
  15. +1 −1 typed-racket-lib/typed-racket/infer/constraint-structs.rkt
  16. +336 −338 typed-racket-lib/typed-racket/infer/infer-unit.rkt
  17. +106 −26 typed-racket-lib/typed-racket/infer/intersect.rkt
  18. +61 −50 typed-racket-lib/typed-racket/infer/promote-demote.rkt
  19. +9 −8 typed-racket-lib/typed-racket/infer/signatures.rkt
  20. +35 −35 typed-racket-lib/typed-racket/private/parse-type.rkt
  21. +11 −14 typed-racket-lib/typed-racket/private/type-contract.rkt
  22. +234 −0 typed-racket-lib/typed-racket/rep/core-rep.rkt
  23. +32 −31 typed-racket-lib/typed-racket/rep/free-variance.rkt
  24. +0 −45 typed-racket-lib/typed-racket/rep/interning.rkt
  25. +30 −16 typed-racket-lib/typed-racket/rep/object-rep.rkt
  26. +87 −42 typed-racket-lib/typed-racket/rep/prop-rep.rkt
  27. +446 −366 typed-racket-lib/typed-racket/rep/rep-utils.rkt
  28. +156 −0 typed-racket-lib/typed-racket/rep/type-mask.rkt
  29. +735 −593 typed-racket-lib/typed-racket/rep/type-rep.rkt
  30. +62 −0 typed-racket-lib/typed-racket/rep/values-rep.rkt
  31. +2 −2 typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
  32. +7 −7 typed-racket-lib/typed-racket/typecheck/check-below.rkt
  33. +1 −1 typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
  34. +5 −4 typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
  35. +1 −1 typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
  36. +7 −7 typed-racket-lib/typed-racket/typecheck/error-message.rkt
  37. +1 −1 typed-racket-lib/typed-racket/typecheck/find-annotation.rkt
  38. +2 −2 typed-racket-lib/typed-racket/typecheck/possible-domains.rkt
  39. +1 −1 typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
  40. +6 −6 typed-racket-lib/typed-racket/typecheck/signatures.rkt
  41. +8 −7 typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
  42. +2 −2 typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt
  43. +1 −1 typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt
  44. +1 −1 typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-main.rkt
  45. +3 −3 typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
  46. +1 −1 typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
  47. +46 −25 typed-racket-lib/typed-racket/typecheck/tc-envops.rkt
  48. +18 −12 typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
  49. +0 −3 typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
  50. +145 −142 typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
  51. +4 −4 typed-racket-lib/typed-racket/typecheck/tc-if.rkt
  52. +17 −15 typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
  53. +41 −43 typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
  54. +50 −45 typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
  55. +3 −5 typed-racket-lib/typed-racket/typecheck/tc-send.rkt
  56. +2 −2 typed-racket-lib/typed-racket/typecheck/tc-structs.rkt
  57. +177 −164 typed-racket-lib/typed-racket/typecheck/tc-subst.rkt
  58. +4 −3 typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
  59. +4 −4 typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt
  60. +8 −10 typed-racket-lib/typed-racket/types/abbrev.rkt
  61. +87 −121 typed-racket-lib/typed-racket/types/base-abbrev.rkt
  62. +11 −30 typed-racket-lib/typed-racket/types/classes.rkt
  63. +33 −23 typed-racket-lib/typed-racket/types/current-seen.rkt
  64. +4 −1 typed-racket-lib/typed-racket/types/kw-types.rkt
  65. +7 −10 typed-racket-lib/typed-racket/types/match-expanders.rkt
  66. +90 −91 typed-racket-lib/typed-racket/types/overlap.rkt
  67. +52 −38 typed-racket-lib/typed-racket/types/path-type.rkt
  68. +133 −69 typed-racket-lib/typed-racket/types/printer.rkt
  69. +219 −128 typed-racket-lib/typed-racket/types/prop-ops.rkt
  70. +76 −94 typed-racket-lib/typed-racket/types/resolve.rkt
  71. +0 −137 typed-racket-lib/typed-racket/types/structural.rkt
  72. +133 −121 typed-racket-lib/typed-racket/types/substitute.rkt
  73. +10 −9 typed-racket-lib/typed-racket/types/{remove.rkt → subtract.rkt}
  74. +656 −628 typed-racket-lib/typed-racket/types/subtype.rkt
  75. +3 −3 typed-racket-lib/typed-racket/types/tc-error.rkt
  76. +19 −19 typed-racket-lib/typed-racket/types/tc-result.rkt
  77. +3 −3 typed-racket-lib/typed-racket/types/type-table.rkt
  78. +4 −11 typed-racket-lib/typed-racket/types/union.rkt
  79. +18 −11 typed-racket-lib/typed-racket/types/update.rkt
  80. +4 −16 typed-racket-lib/typed-racket/types/utils.rkt
  81. +55 −0 typed-racket-lib/typed-racket/utils/primitive-comparison.rkt
  82. +26 −7 typed-racket-lib/typed-racket/utils/utils.rkt
  83. +1 −1 typed-racket-more/typed/racket/sandbox.rkt
  84. +1 −1 typed-racket-test/fail/pr13209.rkt
  85. +10 −11 typed-racket-test/succeed/type-printer-single-level.rkt
  86. +1 −1 typed-racket-test/unit-tests/check-below-tests.rkt
  87. +72 −71 typed-racket-test/unit-tests/class-tests.rkt
  88. +4 −4 typed-racket-test/unit-tests/contract-tests.rkt
  89. +1 −1 typed-racket-test/unit-tests/generalize-tests.rkt
  90. +24 −23 typed-racket-test/unit-tests/metafunction-tests.rkt
  91. +5 −5 typed-racket-test/unit-tests/parse-type-tests.rkt
  92. +1 −1 typed-racket-test/unit-tests/prop-tests.rkt
  93. +6 −6 typed-racket-test/unit-tests/remove-intersect-tests.rkt
  94. +5 −3 typed-racket-test/unit-tests/special-env-typecheck-tests.rkt
  95. +8 −4 typed-racket-test/unit-tests/subtype-tests.rkt
  96. +19 −15 typed-racket-test/unit-tests/type-printer-tests.rkt
  97. +314 −312 typed-racket-test/unit-tests/typecheck-tests.rkt
@@ -17,9 +17,7 @@
(add-ann #'arg #'ty)]))
(define-for-syntax (add-ann expr-stx ty-stx)
- (quasisyntax/loc expr-stx
- (#,(type-ascription-property #'#%expression ty-stx)
- #,expr-stx)))
+ (type-ascription-property (quasisyntax/loc expr-stx (#%expression #,expr-stx)) ty-stx))
(define-syntax (inst stx)
(syntax-parse stx #:literals (:)
@@ -3,7 +3,7 @@
(begin
(require
(for-syntax racket/base racket/syntax syntax/parse)
- (only-in (rep type-rep) Type/c? make-Values)
+ (only-in (rep type-rep values-rep) Type? make-Values)
racket/list racket/math racket/flonum racket/extflonum racket/unsafe/ops racket/sequence racket/match
(for-template racket/flonum racket/extflonum racket/fixnum racket/math racket/unsafe/ops racket/base
(only-in "../types/numeric-predicates.rkt" index?))
@@ -23,7 +23,7 @@
(only-in racket/private/pre-base new-apply-proc)
(only-in (types abbrev) [-Boolean B] [-Symbol Sym] -Flat)
(only-in (types numeric-tower) [-Number N])
- (only-in (rep type-rep)
+ (only-in (rep type-rep values-rep)
make-ClassTop
make-UnitTop
make-Name
@@ -64,7 +64,7 @@
[current-type-names
(if (attribute verbose-kw) '() (current-type-names))]
[current-print-unexpanded (box '())])
- (define type (pretty-format-type (parse-type #'ty)))
+ (define type (pretty-format-rep (parse-type #'ty)))
(define unexpanded
(remove-duplicates (unbox (current-print-unexpanded))))
(define cue (if (null? unexpanded)
@@ -92,7 +92,7 @@
(define-repl-op :print-type-impl (_ e) #'e
(λ (type)
#`(displayln
- #,(pretty-format-type
+ #,(pretty-format-rep
(match type
[(tc-result1: t f o) t]
[(tc-results: t) (-values t)]
@@ -108,7 +108,7 @@
(op dummy-arg ...)))
(λ (type)
#`(display
- #,(pretty-format-type
+ #,(pretty-format-rep
(match type
[(tc-result1: (and t (Function: _)) f o) t]))))
"must be applied to at least one argument" )
@@ -124,6 +124,6 @@
[(Function: '())
"Desired return type not in the given function's range.\n"]
[(Function: arrs)
- (pretty-format-type cleaned)])))]
+ (pretty-format-rep cleaned)])))]
[_ (error (format "~a: not a function" (syntax->datum #'op)))]))
"must be applied to exactly two arguments"))
@@ -12,7 +12,6 @@
(rep type-rep)
(for-template (base-env top-interaction))
(utils utils tc-utils arm)
- (only-in (types printer) pretty-format-type)
"standard-inits.rkt"
"tc-setup.rkt")
@@ -1,14 +1,18 @@
#lang racket/base
(require racket/dict racket/sequence)
-(provide id< sorted-dict-map in-sorted-dict)
+(provide id< sorted-dict-map sorted-dict-for-each in-sorted-dict)
(define (id< a b) (symbol<? (syntax-e a) (syntax-e b)))
(define (sorted-dict-map dict f <)
- (define sorted (sort #:key car (dict-map dict cons) <))
+ (define sorted (sort (dict-map dict cons) (λ (x y) (< (car x) (car y)))))
(map (lambda (a) (f (car a) (cdr a))) sorted))
+(define (sorted-dict-for-each dict f <)
+ (define sorted (sort (dict-map dict cons) (λ (x y) (< (car x) (car y)))))
+ (for-each (lambda (a) (f (car a) (cdr a))) sorted))
+
(define (in-sorted-dict dict <)
(define sorted (sort #:key car (dict-map dict cons) <))
(in-dict sorted))
@@ -18,9 +18,10 @@
register-types
unregister-type
check-all-registered-types
- type-env-map)
+ type-env-map
+ type-env-for-each)
-(lazy-require ["../rep/type-rep.rkt" (Type/c? type-equal?)])
+(lazy-require ["../rep/type-rep.rkt" (Type? type-equal?)])
;; free-id-table from id -> type or Box[type]
;; where id is a variable, and type is the type of the variable
@@ -36,7 +37,7 @@
(cond [(free-id-table-ref the-mapping id (lambda _ #f))
=> (lambda (e)
(define t (if (box? e) (unbox e) e))
- (unless (and (Type/c? t) (type-equal? t type))
+ (unless (and (Type? t) (type-equal? t type))
(tc-error/delayed #:stx id "Duplicate type annotation of ~a for ~a, previous was ~a" type (syntax-e id) t))
(when (box? e)
(free-id-table-set! the-mapping id t)))]
@@ -50,7 +51,7 @@
=>
(λ (t) ;; it's ok to annotate with the same type
(define t* (if (box? t) (unbox t) t))
- (unless (and (Type/c? t*) (type-equal? type t*))
+ (unless (and (Type? t*) (type-equal? type t*))
(tc-error/delayed #:stx id "Duplicate type annotation of ~a for ~a, previous was ~a" type (syntax-e id) t*)))]
[else (free-id-table-set! the-mapping id (box type))]))
@@ -104,3 +105,6 @@
;; (id type -> T) -> listof[T]
(define (type-env-map f)
(sorted-dict-map the-mapping f id<))
+
+(define (type-env-for-each f)
+ (sorted-dict-for-each the-mapping f id<))
@@ -10,7 +10,10 @@
"mvar-env.rkt"
"signature-env.rkt"
(rename-in racket/private/sort [sort raw-sort])
- (rep type-rep object-rep prop-rep rep-utils free-variance)
+ (rep core-rep type-rep
+ prop-rep rep-utils
+ object-rep values-rep
+ free-variance)
(for-syntax syntax/parse racket/base)
(types abbrev struct-table union utils)
data/queue
@@ -57,10 +60,10 @@
;; Compute for a given type how many times each type inside of it
;; is referenced
(define (compute-popularity ty)
- (hash-update! pop-table ty add1 0)
- (define (count ty) (compute-popularity ty) ty)
- (type-case (#:Type count #:Prop (sub-f count) #:Object (sub-o count))
- ty))
+ (when (Type? ty)
+ (hash-update! pop-table ty add1 0))
+ (when (walkable? ty)
+ (Rep-walk compute-popularity ty)))
(define (popular? ty)
(> (hash-ref pop-table ty 0) 5))
@@ -98,7 +101,7 @@
(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 type->sexp ts)) < Type-seq #f))]
+ `(make-Union (list ,@(map type->sexp ts)))]
[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
@@ -175,11 +178,11 @@
,(type->sexp t)
,(type->sexp ft)
,(object->sexp pth))]
- [(Function: (list (arr: dom (Values: (list (Result: t (PropSet: (NotTypeProp: (Path: pth (list 0 0))
+ [(Function: (list (arr: dom (Values: (list (Result: t (PropSet: (NotTypeProp: (Path: pth (cons 0 0))
(== -False))
- (TypeProp: (Path: pth (list 0 0))
+ (TypeProp: (Path: pth (cons 0 0))
(== -False)))
- (Path: pth (list 0 0)))))
+ (Path: pth (cons 0 0)))))
#f #f '())))
`(->acc (list ,@(map type->sexp dom))
,(type->sexp t)
@@ -217,8 +220,7 @@
`(quote ,v)))]
[(Union: elems) (split-union elems)]
[(Intersection: elems)
- `(make-Intersection (set ,@(for/list ([elem (in-immutable-set elems)])
- (type->sexp elem))))]
+ `(make-Intersection (list ,@(map type->sexp elems)))]
[(Name: stx 0 #t)
`(-struct-name (quote-syntax ,stx))]
[(Name: stx args struct?)
@@ -316,7 +318,7 @@
;; Helper for class/row clauses
(define (convert-row-clause members [inits? #f])
- (for/list ([m members])
+ (for/list ([m (in-list members)])
`(list (quote ,(car m))
,(type->sexp (cadr m))
,@(if inits? (cddr m) '()))))
@@ -343,15 +345,15 @@
(define (object->sexp obj)
(match obj
[(Empty:) `(make-Empty)]
- [(Path: null (list 0 arg))
+ [(Path: null (cons 0 arg))
`(-arg-path ,arg)]
- [(Path: null (list depth arg))
+ [(Path: null (cons depth arg))
`(-arg-path ,arg ,depth)]
[(Path: pes i)
`(make-Path (list ,@(map path-elem->sexp pes))
,(if (identifier? i)
`(quote-syntax ,i)
- `(list ,(car i) ,(cadr i))))]))
+ `(cons ,(car i) ,(cdr i))))]))
;; Path-Element -> SExp
;; Convert a path element in an object to an s-expression
@@ -383,16 +385,16 @@
;; the type serialization pass. Only walks the environments that
;; actually track types.
(define (compute-all-popularities)
- (define (count-env map)
+ (define (count-env for-each)
(define (count id ty) (compute-popularity ty))
(define (bound-f id v)
(and (bound-in-this-module id) (count id v)))
- (map bound-f))
+ (for-each bound-f))
- (count-env type-name-env-map)
- (count-env type-alias-env-map)
- (count-env type-env-map)
- (count-env signature-env-map))
+ (count-env type-name-env-for-each)
+ (count-env type-alias-env-for-each)
+ (count-env type-env-for-each)
+ (count-env signature-env-for-each))
(define (tname-env-init-code)
(make-init-code
@@ -419,10 +421,12 @@
(λ (f) (dict-map mvar-env f))
(lambda (id v) (and v #`(register-mutated-var #'#,id)))))
+;; see 'finalize-signatures!' in 'env/signature-env.rkt',
+;; which forces these delays after all the signatures are parsed
(define (signature-env-init-code)
(make-init-code
signature-env-map
- (lambda (id sig) #`(register-signature! #'#,id #,(quote-type sig)))))
+ (lambda (id sig) #`(register-signature! #'#,id (delay #,(quote-type sig))))))
(define (make-struct-table-code)
(make-init-code
@@ -10,21 +10,20 @@
racket/keyword-transform racket/list
(for-syntax syntax/parse racket/base)
(contract-req)
- (env type-env-structs global-env mvar-env)
+ (env type-env-structs global-env)
(utils tc-utils)
- (only-in (rep type-rep) Type/c)
+ (only-in (rep type-rep) Type?)
(typecheck renamer)
(except-in (types utils abbrev kw-types) -> ->* one-of/c))
-(require-for-cond-contract (rep object-rep))
+(require-for-cond-contract (rep object-rep core-rep))
(provide lexical-env
with-lexical-env
with-lexical-env/extend-types
- with-lexical-env/extend-types+aliases
- update-type/lexical)
+ with-lexical-env/extend-types+aliases)
(provide/cond-contract
- [lookup-type/lexical ((identifier?) (env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type/c #f))]
+ [lookup-type/lexical ((identifier?) (env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type? #f))]
[lookup-alias/lexical ((identifier?) (env?) . ->* . (or/c Path? Empty?))])
;; the current lexical environment
@@ -74,28 +73,4 @@
;; looks up the representative object for an id (i.e. itself or an alias if one exists)
(define (lookup-alias/lexical i [env (lexical-env)])
- (lookup-alias env i -id-path))
-
-
-;; refine the type of i in the lexical env
-;; (identifier type -> type) identifier -> environment
-;; a macro for inlining :(
-(define-syntax (update-type/lexical stx)
- (syntax-parse stx
- [(_ f i env)
- #:declare f (expr/c #'(identifier? Type/c . -> . Type/c))
- #:declare i (expr/c #'identifier?)
- #:declare env (expr/c #'prop-env?)
- ;; check if i is ever the target of a set!
- ;; or is a top-level variable
- #'(if (or (is-var-mutated? i)
- (not (identifier-binding i)))
- ;; if it is, we do nothing
- env
- ;; otherwise, refine the type
- (parameterize
- ([current-orig-stx i])
- (let* ([v (lookup-type/lexical i env #:fail (lambda _ Univ))]
- [new-v (f i v)]
- [new-env (extend env i new-v)])
- new-env)))]))
+ (lookup-alias env i -id-path))
@@ -8,6 +8,7 @@
lookup-signature
lookup-signature/check
signature-env-map
+ signature-env-for-each
with-signature-env/extend)
(require syntax/id-table
@@ -45,27 +46,15 @@
;; Iterate over the signature environment forcing the types of bindings
;; in each signature
(define (finalize-signatures!)
- (signature-env
- (make-immutable-free-id-table
- (signature-env-map
- (lambda (id sig)
- (cons
- id
- (match sig
- [(Signature: name extends mapping)
- (make-Signature
- name
- extends
- (map
- (match-lambda [(cons id ty) (cons id (force ty))])
- mapping))]
- [_ #f])))))))
+ (sorted-dict-for-each (signature-env) (λ (id sig) (force sig)) id<))
;; lookup-signature : identifier? -> (or/c #f Signature?)
;; look up the signature corresponding to the given identifier
;; in the signature environment
(define (lookup-signature id)
- (free-id-table-ref (signature-env) id #f))
+ (cond
+ [(free-id-table-ref (signature-env) id #f) => force]
+ [else #f]))
;; lookup-signature/check : identifier? -> Signature?
;; lookup the identifier in the signature environment
@@ -78,4 +67,7 @@
#:stx id)))
(define (signature-env-map f)
- (sorted-dict-map (signature-env) f id<))
+ (sorted-dict-map (signature-env) (λ (id sig) (f id (force sig))) id<))
+
+(define (signature-env-for-each f)
+ (sorted-dict-for-each (signature-env) (λ (id sig) (f id (force sig))) id<))
Oops, something went wrong.

0 comments on commit 24c64e9

Please sign in to comment.