Change type<? to rep<?.

Also moves type-equal and rep<? to rep-utils.

original commit: c66d0286cf104d5f30635e850caad504f7201b49
This commit is contained in:
Eric Dobson 2014-06-18 21:11:07 -07:00
parent 259ab755d0
commit f850aa0919
3 changed files with 15 additions and 22 deletions

View File

@ -370,6 +370,11 @@
(app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals)))
vals]))
;; Rep equality and inequality
(define (rep-equal? s t)
(eq? (Rep-seq s) (Rep-seq t)))
(define (rep<? s t)
(< (Rep-seq s) (Rep-seq t)))
(provide
Rep-values
@ -377,7 +382,11 @@
[Rep-free-vars free-vars*]
[Rep-free-idxs free-idxs*]))
(provide/cond-contract (struct Rep ([seq exact-nonnegative-integer?]
[free-vars (hash/c symbol? variance?)]
[free-idxs (hash/c symbol? variance?)]
[stx (or/c #f syntax?)])))
(provide/cond-contract
[rename rep-equal? type-equal? (Type? Type? . -> . boolean?)]
[rename rep<? type<? (Type? Type? . -> . boolean?)]
[rename rep<? filter<? (Filter? Filter? . -> . boolean?)]
[struct Rep ([seq exact-nonnegative-integer?]
[free-vars (hash/c symbol? variance?)]
[free-idxs (hash/c symbol? variance?)]
[stx (or/c #f syntax?)])])

View File

@ -29,7 +29,7 @@
PolyDots-n
Class? Row? Row:
free-vars*
type-compare type<?
type-equal?
remove-dups
sub-t sub-f sub-o sub-pe
(rename-out [Class:* Class:]
@ -48,7 +48,6 @@
[PolyDots-body* PolyDots-body]
[PolyRow-body* PolyRow-body]))
(provide/cond-contract [type-equal? (Rep? Rep? . -> . boolean?)])
;; Ugly hack - should use units
(lazy-require
@ -579,21 +578,6 @@
[(Scope: sc*) (remove-scopes (sub1 n) sc*)]
[_ (int-err "Tried to remove too many scopes: ~a" sc)])))
;; type equality
(define/cond-contract (type-equal? s t)
(Rep? Rep? . -> . boolean?)
(eq? (Rep-seq s) (Rep-seq t)))
;; inequality - good
(define/cond-contract (type<? s t)
(Rep? Rep? . -> . boolean?)
(< (Rep-seq s) (Rep-seq t)))
(define/cond-contract (type-compare s t)
(Rep? Rep? . -> . (or/c -1 0 1))
(cond [(type-equal? s t) 0]
[(type<? s t) 1]
[else -1]))
(define ((sub-f st) e)
(filter-case (#:Type st

View File

@ -1,7 +1,7 @@
#lang racket/base
(require "../utils/utils.rkt"
(rep type-rep)
(rep type-rep rep-utils)
(prefix-in c: (contract-req))
(types subtype base-abbrev resolve)
racket/match