Cleanup flonum-op check, and contract fixups.

original commit: df3d6fd31c47b092830659c1f0ef9bdfdbc1c001
This commit is contained in:
Eric Dobson 2013-05-25 00:15:00 -07:00
parent df3d26c487
commit 611b61ca36
2 changed files with 12 additions and 13 deletions

View File

@ -2,7 +2,7 @@
(begin
(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
(only-in "../types/numeric-predicates.rkt" index?))
(only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos]))
@ -691,14 +691,13 @@
[unsafe-fllog fllog]
[unsafe-flexp flexp]
[unsafe-flexpt flexpt])))
(define phase (namespace-base-phase (namespace-anchor->namespace anchor)))
(define phase (namespace-base-phase (namespace-anchor->namespace anchor)))
(for-each
(lambda (ids)
(let* ((ids (syntax->list ids)) (id1 (first ids)) (id2 (second ids)))
(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))))
(syntax->list flonum-ops)))
(for ([op-pair (in-syntax flonum-ops)])
(match op-pair
[(app syntax->list (list id1 id2))
(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))])))
)

View File

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