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

Change name of recursive contract to not colide with racket/contract.

Browse Source
This commit is contained in:
Eric Dobson 2014-01-11 09:59:11 -08:00
parent a8199ad1d2
commit c95084cedf
17 changed files with 58 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
View File

@ -266,24 +266,24 @@
(match-define (and n*s (list untyped-n* typed-n* both-n*)) (generate-temporaries (list n n n)))
(define rv
(hash-set recursive-values n
(triple (recursive-contract-use untyped-n*)
(recursive-contract-use typed-n*)
(recursive-contract-use both-n*))))
(triple (recursive-sc-use untyped-n*)
(recursive-sc-use typed-n*)
(recursive-sc-use both-n*))))
(case typed-side
[(both) (recursive-contract
[(both) (recursive-sc
(list both-n*)
(list (loop b 'both rv))
(recursive-contract-use both-n*))]
(recursive-sc-use both-n*))]
[(typed untyped)
;; TODO not fail in cases that don't get used
(define untyped (loop b 'untyped rv))
(define typed (loop b 'typed rv))
(define both (loop b 'both rv))
(recursive-contract
(recursive-sc
n*s
(list untyped typed both)
(recursive-contract-use (if (from-typed? typed-side) typed-n* untyped-n*)))])]
(recursive-sc-use (if (from-typed? typed-side) typed-n* untyped-n*)))])]
[(Instance: (? Mu? t))
(t->sc (make-Instance (resolve-once t)))]
[(Instance: (Class: _ _ (list (list names functions) ...)))
@ -305,9 +305,9 @@
(for/list ([fty flds] [mut? mut?])
(t->sc fty #:recursive-values (hash-set
recursive-values
nm (recursive-contract-use nm*)))))
(recursive-contract (list nm*) (list (struct/sc nm (ormap values mut?) fields))
(recursive-contract-use nm*))]
nm (recursive-sc-use nm*)))))
(recursive-sc (list nm*) (list (struct/sc nm (ormap values mut?) fields))
(recursive-sc-use nm*))]
[else (flat/sc #`(flat-named-contract '#,(syntax-e pred?) #,pred?))])]
[(Syntax: (Base: 'Symbol _ _ _)) identifier?/sc]
[(Syntax: t)

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/README
View File

@ -23,9 +23,9 @@ Internal Implementation Details:
A static contract is one of three things:
recursive-contract:
recursive-sc:
This introduces bindings for recursive contracts.
recursive-contract-use:
recursive-sc-use:
This is a reference to a previously introduced recursive contract.
combinator:
This is a combinator or leaf contract.

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/any.rkt
View File

@ -6,7 +6,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/match
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/base)
(for-syntax racket/base racket/syntax syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt
View File

@ -6,7 +6,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/list racket/match
unstable/contract
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/base)
(for-syntax racket/base syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt
View File

@ -6,7 +6,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/list racket/match
unstable/contract
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/base)
(for-syntax racket/base syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt
View File

@ -5,7 +5,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/list racket/match
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/base)
(for-syntax racket/base racket/syntax syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/lengths.rkt
View File

@ -9,7 +9,7 @@
"../terminal.rkt"
"simple.rkt"
racket/match
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base))
(provide

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/none.rkt
View File

@ -6,7 +6,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/match
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/base)
(for-syntax racket/base racket/syntax syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt
View File

@ -6,7 +6,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/list racket/match
unstable/contract
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/class)
(for-syntax racket/base syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
View File

@ -8,7 +8,7 @@
"../terminal.rkt"
racket/list racket/match
unstable/contract
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/parametric)
(for-syntax racket/base syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt
View File

@ -11,7 +11,7 @@
"../constraints.rkt"
racket/list
racket/match
(except-in racket/contract recursive-contract))
racket/contract)
(provide
(contract-out

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/struct.rkt
View File

@ -5,7 +5,7 @@
(require "../structures.rkt" "../constraints.rkt"
racket/list racket/match
unstable/contract
(except-in racket/contract recursive-contract)
racket/contract
(for-template racket/base racket/contract/base)
(for-syntax racket/base syntax/parse))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt
View File

@ -14,7 +14,7 @@
racket/contract/base
racket/set
unstable/contract)
(except-in racket/contract recursive-contract))
racket/contract)
(begin-for-syntax

16
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/instantiate.rkt
View File

@ -7,19 +7,19 @@
racket/match
racket/dict
racket/sequence
(for-template racket/base (prefix-in c: racket/contract))
racket/contract
(for-template racket/base racket/contract)
"kinds.rkt"
"parametric-check.rkt"
"structures.rkt"
"constraints.rkt"
"equations.rkt")
(require (prefix-in c: racket/contract))
(provide
(c:contract-out
(contract-out
[instantiate
(c:parametric->/c (a) ((static-contract? (c:-> #:reason (c:or/c #f string?) a))
(contract-kind?) . c:->* . (c:or/c a syntax?)))]))
(parametric->/c (a) ((static-contract? (-> #:reason (or/c #f string?) a))
(contract-kind?) . ->* . (or/c a syntax?)))]))
;; Providing these so that tests can work directly with them.
(module* internals #f
@ -41,7 +41,7 @@
(define (compute-constraints sc max-kind)
(define (recur sc)
(match sc
[(recursive-contract names values body)
[(recursive-sc names values body)
(close-loop names (map recur values) (recur body))]
[(? sc?)
(sc->constraints sc recur)]))
@ -74,7 +74,7 @@
(define (instantiate/inner sc recursive-kinds)
(define (recur sc)
(match sc
[(recursive-contract names values body)
[(recursive-sc names values body)
(define raw-names (generate-temporaries names))
(define raw-bindings
(for/list ([raw-name (in-list raw-names)]
@ -83,7 +83,7 @@
(define bindings
(for/list ([name (in-list names)]
[raw-name (in-list raw-names)])
#`[#,name (c:recursive-contract #,raw-name
#`[#,name (recursive-contract #,raw-name
#,(kind->keyword
(hash-ref recursive-kinds name)))]))
#`(letrec (#,@bindings #,@raw-bindings) #,(recur body))]

10
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt
View File

@ -11,7 +11,7 @@
racket/dict
syntax/id-table
racket/list
(except-in racket/contract recursive-contract)
racket/contract
racket/match)
@ -106,9 +106,9 @@
(define table (make-free-id-table))
(define (recur sc variance)
(match sc
[(recursive-contract-use id)
[(recursive-sc-use id)
(dict-set! table id #t)]
[(recursive-contract names values body)
[(recursive-sc names values body)
(recur body 'covariant)
(for ([name (in-list names)]
[value (in-list values)])
@ -132,7 +132,7 @@
(define (trim sc variance)
(match sc
[(recursive-contract names values body)
[(recursive-sc names values body)
(define new-body (trim body 'covariant))
(define new-name-values
@ -145,7 +145,7 @@
(map second new-name-values)))
(if (empty? new-names)
new-body
(recursive-contract new-names new-values new-body))]
(recursive-sc new-names new-values new-body))]
[else
(sc-map sc trim)]))
(trim sc 'covariant))

7
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/parametric-check.rkt
View File

@ -5,8 +5,7 @@
(require
racket/match
[except-in racket/contract recursive-contract]
racket/contract
racket/dict
syntax/id-table
"structures.rkt"
@ -38,11 +37,11 @@
(variable-ref (get-var e)))))]
[(parametric-var/sc: id)
(add-equation! eqs (get-var sc) (lambda () 1))]
[(recursive-contract names values body)
[(recursive-sc names values body)
(for ([name names] [value values])
(add-equation! eqs (get-rec-var name) (lambda () (variable-ref (get-var value)))))
(add-equation! eqs (get-var sc) (lambda () (variable-ref (get-var body))))]
[(recursive-contract-use id)
[(recursive-sc-use id)
(add-equation! eqs (get-var sc) (lambda () (variable-ref (get-rec-var id))))]
[else
(get-var sc)])

34
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/structures.rkt
View File

@ -3,15 +3,15 @@
;; Internal structures for representing a static contract.
(require racket/match racket/list racket/generic
(except-in racket/contract recursive-contract)
racket/contract
"kinds.rkt" "constraints.rkt")
(provide
(contract-out
(struct recursive-contract ([names (listof identifier?)]
(struct recursive-sc ([names (listof identifier?)]
[values (listof static-contract?)]
[body static-contract?]))
(struct recursive-contract-use ([name identifier?]))
(struct recursive-sc-use ([name identifier?]))
(struct combinator ([args sequence?]))
(struct static-contract ())
[sc-map (static-contract? (static-contract? variance/c . -> . static-contract?) . -> . static-contract?)]
@ -28,8 +28,8 @@
(define variance/c (or/c 'covariant 'contravariant 'invariant))
(define (recursive-contract-write-proc v port mode)
(match-define (recursive-contract names vals body) v)
(define (recursive-sc-write-proc v port mode)
(match-define (recursive-sc names vals body) v)
(define recur
(case mode
[(#t) write]
@ -56,8 +56,8 @@
(recur body port)
(display close port))
(define (recursive-contract-use-write-proc v port mode)
(display (syntax->datum (recursive-contract-use-name v)) port))
(define (recursive-sc-use-write-proc v port mode)
(display (syntax->datum (recursive-sc-use-name v)) port))
(define (combinator-write-proc v port mode)
(match-define (combinator args) v)
@ -127,31 +127,31 @@
;; - values : (listof static-contract?)
;; - body : static-contract?
;; names and value must have the same length.
(struct recursive-contract static-contract (names values body)
(struct recursive-sc static-contract (names values body)
#:transparent
#:methods gen:sc
[(define (sc-map v f)
(match v
[(recursive-contract names values body)
(recursive-contract names (map (λ (v) (f v 'covariant)) values) (f body 'covariant))]))
[(recursive-sc names values body)
(recursive-sc names (map (λ (v) (f v 'covariant)) values) (f body 'covariant))]))
(define (sc-traverse v f)
(match v
[(recursive-contract names values body)
[(recursive-sc names values body)
(for-each (λ (v) (f v 'covariant)) values)
(f body 'covariant)
(void)]))]
#:methods gen:custom-write [(define write-proc recursive-contract-write-proc)])
#:methods gen:custom-write [(define write-proc recursive-sc-write-proc)])
;; A use of a contract bound by recursive-contract
;; A use of a contract bound by recursive-sc
;; - name : identifier?
(struct recursive-contract-use static-contract (name)
(struct recursive-sc-use static-contract (name)
#:transparent
#:methods gen:sc
[(define (sc-map v f) v)
(define (sc-traverse v f) (void))
(define (sc->contract v f) (recursive-contract-use-name v))
(define (sc->constraints v f) (variable-contract-restrict (recursive-contract-use-name v)))]
#:methods gen:custom-write [(define write-proc recursive-contract-use-write-proc)])
(define (sc->contract v f) (recursive-sc-use-name v))
(define (sc->constraints v f) (variable-contract-restrict (recursive-sc-use-name v)))]
#:methods gen:custom-write [(define write-proc recursive-sc-use-write-proc)])
;; Super struct of static contract combinators.
;; Provides printing functionality.