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

Cleanup flonum-op check, and contract fixups.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-25 00:15:00 -07:00
parent 564a7bcf2f
commit df3d6fd31c
2 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-racket/base-env/base-env-numeric.rkt
View File

@ -2,7 +2,7 @@
(begin (begin
(require (require
racket/list racket/math racket/flonum racket/unsafe/ops racket/list racket/math racket/flonum racket/unsafe/ops unstable/sequence racket/match
(for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base
(only-in "../types/numeric-predicates.rkt" index?)) (only-in "../types/numeric-predicates.rkt" index?))
(only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos])) (only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos]))
@ -691,14 +691,13 @@
[unsafe-fllog fllog] [unsafe-fllog fllog]
[unsafe-flexp flexp] [unsafe-flexp flexp]
[unsafe-flexpt flexpt]))) [unsafe-flexpt flexpt])))
(define phase (namespace-base-phase (namespace-anchor->namespace anchor))) (define phase (namespace-base-phase (namespace-anchor->namespace anchor)))
(for-each (for ([op-pair (in-syntax flonum-ops)])
(lambda (ids) (match op-pair
(let* ((ids (syntax->list ids)) (id1 (first ids)) (id2 (second ids))) [(app syntax->list (list id1 id2))
(unless (free-identifier=? id1 id2 (sub1 phase)) (unless (free-identifier=? id1 id2 (sub1 phase))
(error 'flonum-operations "The assumption that the safe and unsafe flonum-ops are the same binding has been violated. ~a and ~a are diffferent bindings." id1 id2)))) (error 'flonum-operations "The assumption that the safe and unsafe flonum-ops are the same binding has been violated. ~a and ~a are diffferent bindings." id1 id2))])))
(syntax->list flonum-ops)))
) )

10
collects/typed-racket/private/type-contract.rkt
View File

@ -15,6 +15,7 @@
(prefix-in t: (types abbrev numeric-tower)) (prefix-in t: (types abbrev numeric-tower))
(private parse-type syntax-properties) (private parse-type syntax-properties)
racket/match unstable/match syntax/struct syntax/stx racket/syntax racket/list racket/match unstable/match syntax/struct syntax/stx racket/syntax racket/list
unstable/sequence
(contract-req) (contract-req)
(for-template racket/base racket/contract racket/set (utils any-wrap) (for-template racket/base racket/contract racket/set (utils any-wrap)
(prefix-in t: (types numeric-predicates)) (prefix-in t: (types numeric-predicates))
@ -76,11 +77,10 @@
(syntax->datum stx))])) (syntax->datum stx))]))
(define (change-contract-fixups forms) (define (change-contract-fixups forms)
(map (lambda (e) (for/list ((e (in-syntax forms)))
(if (not (define/fixup-contract? e)) (if (not (define/fixup-contract? e))
e e
(generate-contract-def e))) (generate-contract-def e))))
(syntax->list forms)))
(define (no-duplicates l) (define (no-duplicates l)
(= (length l) (length (remove-duplicates l)))) (= (length l) (length (remove-duplicates l))))