From 285a2b796dcbd1ece46bfdc63c4ad2be71bac705 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Mon, 13 Jun 2016 02:30:08 -0400 Subject: [PATCH] Add custom equality for simple static contracts This improves memoization of contracts Appears to cut about 6-7% of zo size for the math library. --- .../static-contracts/combinators/simple.rkt | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt index 8e003f71..b2e0ad06 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt @@ -33,6 +33,25 @@ (struct simple-contract static-contract (syntax kind name) #:transparent + #:methods gen:equal+hash + [(define (equal-proc s1 s2 recur) + (and ;; only check s-expression equality because it's + ;; unlikely that TR will compile contracts that are + ;; s-exp equal but aren't actually the same contract + (recur (syntax->datum (simple-contract-syntax s1)) + (syntax->datum (simple-contract-syntax s2))) + (recur (simple-contract-kind s1) + (simple-contract-kind s2)) + (recur (simple-contract-name s1) + (simple-contract-name s2)))) + (define (hash-proc sc hash-code) + (hash-code (list (syntax->datum (simple-contract-syntax sc)) + (simple-contract-kind sc) + (simple-contract-name sc)))) + (define (hash2-proc sc hash-code) + (hash-code (list (syntax->datum (simple-contract-syntax sc)) + (simple-contract-kind sc) + (simple-contract-name sc))))] #:methods gen:sc [(define (sc-map v f) v) (define (sc-traverse v f) (void))