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

Remove uses of srfi/1 in Typed Racket

Browse Source
This commit is contained in:
Asumu Takikawa 2015-01-28 13:30:01 -05:00
parent ef35d21a31
commit 1cbdad12f6
3 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
typed-racket-lib/info.rkt
View File

@ -2,8 +2,7 @@
(define collection 'multi)
(define deps '("srfi-lite-lib"
"base"
(define deps '("base"
"pconvert-lib"
"unstable-contract-lib"
"unstable-list-lib"

6
typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -2,7 +2,7 @@
(require "../utils/utils.rkt"
racket/match unstable/list unstable/sequence racket/set racket/list
(only-in srfi/1 unzip4) (only-in racket/list make-list)
(only-in racket/list make-list)
(contract-req)
(typecheck check-below tc-subst tc-metafunctions)
(utils tc-utils)
@ -323,7 +323,9 @@
(cons p parts-res)))
(call-with-values
(lambda () (unzip4 (reverse parts-res)))
(λ ()
(for/lists (_1 _2 _3 _4) ([xs (in-list (reverse parts-res))])
(values (car xs) (cadr xs) (caddr xs) (cadddr xs))))
list)]))
;; Wrapper over possible-domains that works on types.

16
typed-racket-lib/typed-racket/types/printer.rkt
View File

@ -6,7 +6,7 @@
(require racket/require racket/match unstable/sequence racket/string racket/promise
racket/pretty
racket/list
(prefix-in s: srfi/1)
racket/set
(path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
"rep/rep-utils.rkt" "types/subtype.rkt"
"types/match-expanders.rkt"
@ -161,14 +161,16 @@
[_ #f]))
(force (current-type-names))))
;; names and the sets themselves (not the union types)
;; we use srfi/1 lsets as sets, to use custom type equality.
;; note that racket/set supports lists with equal?, which in
;; the case of Types will be type-equal?
(define candidates
(map (match-lambda [(cons name (Union: elts)) (cons name elts)])
valid-names))
;; some types in the union may not be coverable by the candidates
;; (e.g. type variables, etc.)
(define-values (uncoverable coverable)
(apply s:lset-diff+intersection type-equal? elems (map cdr candidates)))
(values (apply set-subtract elems (map cdr candidates))
(set-intersect elems (apply set-union null (map cdr candidates)))))
;; set cover, greedy algorithm, ~lg n approximation
(let loop ([to-cover coverable]
[candidates candidates]
@ -179,11 +181,13 @@
;; only union types can flow here, and any of those could be expanded
(set-box! (current-print-unexpanded)
(append coverage-names (unbox (current-print-unexpanded))))
(values coverage-names uncoverable)] ; we want the names
;; reverse here to retain the old ordering from when srfi/1 was
;; used to process the list sets
(values coverage-names (reverse uncoverable))] ; we want the names
[else
;; pick the candidate that covers the most uncovered types
(define (covers-how-many? c)
(length (s:lset-intersection type-equal? (cdr c) to-cover)))
(length (set-intersect (cdr c) to-cover)))
(define-values (next _)
(for/fold ([next (car candidates)]
[max-cover (covers-how-many? (car candidates))])
@ -192,7 +196,7 @@
(if (> how-many? max-cover)
(values c how-many?)
(values next max-cover)))))
(loop (s:lset-difference type-equal? to-cover (cdr next))
(loop (set-subtract to-cover (cdr next))
(remove next candidates)
(cons next coverage))])))