From 99a70b38d8c16c84174534d9ae9c3b413e566743 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 9 Nov 2009 02:29:02 +0000 Subject: [PATCH] Move mutated-vars and poly-c libraries to unstable collection. - add docs - change requires - fix `letrec-syntaxes+values' Fix contract on `author+email' svn: r16628 --- collects/scribble/base.ss | 2 +- .../scribblings/reference/syntax-model.scrbl | 2 +- collects/typed-scheme/env/lexical-env.ss | 3 +- .../typed-scheme/private/type-contract.ss | 2 +- collects/typed-scheme/typecheck/tc-if.ss | 2 +- .../typed-scheme/typecheck/tc-toplevel.ss | 3 +- .../utils => unstable}/mutated-vars.ss | 7 ++-- .../utils => unstable}/poly-c.ss | 0 .../unstable/scribblings/mutated-vars.scrbl | 34 +++++++++++++++++++ collects/unstable/scribblings/poly-c.scrbl | 32 +++++++++++++++++ collects/unstable/scribblings/unstable.scrbl | 2 ++ 11 files changed, 79 insertions(+), 10 deletions(-) rename collects/{typed-scheme/utils => unstable}/mutated-vars.ss (92%) rename collects/{typed-scheme/utils => unstable}/poly-c.ss (100%) create mode 100644 collects/unstable/scribblings/mutated-vars.scrbl create mode 100644 collects/unstable/scribblings/poly-c.scrbl diff --git a/collects/scribble/base.ss b/collects/scribble/base.ss index 67df2aad37..00727776f7 100644 --- a/collects/scribble/base.ss +++ b/collects/scribble/base.ss @@ -120,7 +120,7 @@ (provide/contract [author (->* (content?) () #:rest (listof content?) block?)] - [author+email (-> content? string? element?)]) + [author+email (->* (content? string?) (#:obfuscate? any/c) element?)]) (define (author . auths) (make-paragraph diff --git a/collects/scribblings/reference/syntax-model.scrbl b/collects/scribblings/reference/syntax-model.scrbl index f5c15c9fe3..b092581e3b 100644 --- a/collects/scribblings/reference/syntax-model.scrbl +++ b/collects/scribblings/reference/syntax-model.scrbl @@ -229,7 +229,7 @@ the binding (according to @scheme[free-identifier=?]) matters.} (id ...+ . id) id]] -A fully-expanded @tech{syntax object} corresponds to a @deftech{parse} +A @deftech{fully-expanded} @tech{syntax object} corresponds to a @deftech{parse} of a program (i.e., a @deftech{parsed} program), and @tech{lexical information} on its @tech{identifiers} indicates the @tech{parse}. diff --git a/collects/typed-scheme/env/lexical-env.ss b/collects/typed-scheme/env/lexical-env.ss index 51b7d22e68..5e64695a2c 100644 --- a/collects/typed-scheme/env/lexical-env.ss +++ b/collects/typed-scheme/env/lexical-env.ss @@ -3,8 +3,9 @@ (require (except-in "../utils/utils.ss" extend)) (require "type-environments.ss" "type-env.ss" + unstable/mutated-vars (only-in scheme/contract ->* ->) - (utils tc-utils mutated-vars) + (utils tc-utils) (only-in (rep type-rep) Type/c) (except-in (types utils convenience) -> ->*)) diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss index 2c30583615..07a5d1cbcc 100644 --- a/collects/typed-scheme/private/type-contract.ss +++ b/collects/typed-scheme/private/type-contract.ss @@ -17,7 +17,7 @@ mzlib/trace scheme/list (only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c) - (for-template scheme/base scheme/contract (utils poly-c) (only-in scheme/class object% is-a?/c subclass?/c))) + (for-template scheme/base scheme/contract unstable/poly-c (only-in scheme/class object% is-a?/c subclass?/c))) (define (define/fixup-contract? stx) (or (syntax-property stx 'typechecker:contract-def) diff --git a/collects/typed-scheme/typecheck/tc-if.ss b/collects/typed-scheme/typecheck/tc-if.ss index 1584e86705..5e03751843 100644 --- a/collects/typed-scheme/typecheck/tc-if.ss +++ b/collects/typed-scheme/typecheck/tc-if.ss @@ -8,7 +8,7 @@ [remove *remove]) (env lexical-env type-environments) (r:infer infer) - (utils tc-utils mutated-vars) + (utils tc-utils) (typecheck tc-envops tc-metafunctions) syntax/kerncase mzlib/trace diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss index a14e012572..793eefb8e1 100644 --- a/collects/typed-scheme/typecheck/tc-toplevel.ss +++ b/collects/typed-scheme/typecheck/tc-toplevel.ss @@ -11,7 +11,8 @@ (types utils convenience) (private parse-type type-annotation type-contract) (env type-env init-envs type-name-env type-alias-env lexical-env) - (utils tc-utils mutated-vars) + unstable/mutated-vars + (utils tc-utils) "provide-handling.ss" "def-binding.ss" (for-template diff --git a/collects/typed-scheme/utils/mutated-vars.ss b/collects/unstable/mutated-vars.ss similarity index 92% rename from collects/typed-scheme/utils/mutated-vars.ss rename to collects/unstable/mutated-vars.ss index a362bd5361..1e141c546d 100644 --- a/collects/typed-scheme/utils/mutated-vars.ss +++ b/collects/unstable/mutated-vars.ss @@ -1,8 +1,7 @@ #lang scheme/base (require (for-template scheme/base) - syntax/boundmap syntax/kerncase - mzlib/trace) + syntax/boundmap syntax/kerncase) ;; mapping telling whether an identifer is mutated ;; maps id -> boolean @@ -33,12 +32,12 @@ (fmv/list #'b))] [(letrec-values ([_ e] ...) . b) (begin (fmv/list #'(e ...)) (fmv/list #'b))] + [(letrec-syntaxes+values _ ([_ e] ...) . b) (begin (fmv/list #'(e ...)) + (fmv/list #'b))] [(#%expression e) (find-mutated-vars #'e)] ;; all the other forms don't have any expression subforms (like #%top) [_ (void)])) -;(trace find-mutated-vars) - ;; checks to see if a particular variable is ever set!'d ;; is-var-mutated? : identifier -> boolean (define (is-var-mutated? id) (module-identifier-mapping-get table id (lambda _ #f))) diff --git a/collects/typed-scheme/utils/poly-c.ss b/collects/unstable/poly-c.ss similarity index 100% rename from collects/typed-scheme/utils/poly-c.ss rename to collects/unstable/poly-c.ss diff --git a/collects/unstable/scribblings/mutated-vars.scrbl b/collects/unstable/scribblings/mutated-vars.scrbl new file mode 100644 index 0000000000..d6dc4b4e13 --- /dev/null +++ b/collects/unstable/scribblings/mutated-vars.scrbl @@ -0,0 +1,34 @@ +#lang scribble/manual +@(require scribble/eval + (for-label unstable/mutated-vars + scheme/contract + scheme/base)) + +@title[#:tag "mutated-vars"]{Finding Mutated Variables} + +@(define the-eval (make-base-eval)) +@(the-eval '(require unstable/mutated-vars)) + +@defmodule[unstable/mutated-vars] + +@author[@author+email["Sam Tobin-Hochstadt" "samth@ccs.neu.edu"]] + + +@defproc[(find-mutated-vars [stx syntax?]) void?]{ Traverses +@scheme[stx], which should be @scheme[module-level-form] in the sense +of the grammar for +@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{fully-expanded} forms, +and records all of the variables that are mutated.} + +@defproc[(is-var-mutated? [id identifier?]) boolean?]{ +Produces @scheme[#t] if @scheme[id] is mutated by an expression + previously passed to @scheme[find-mutated-vars], otherwise + produces @scheme[#f]. + + +@examples[#:eval the-eval +(find-mutated-vars #'(begin (set! var 'foo) 'bar)) +(is-var-mutated? #'var) +(is-var-mutated? #'other-var) +] +} diff --git a/collects/unstable/scribblings/poly-c.scrbl b/collects/unstable/scribblings/poly-c.scrbl new file mode 100644 index 0000000000..1fd2af371e --- /dev/null +++ b/collects/unstable/scribblings/poly-c.scrbl @@ -0,0 +1,32 @@ +#lang scribble/manual +@(require scribble/eval + (for-label unstable/poly-c + scheme/contract + scheme/base)) + +@title[#:tag "poly-c"]{Anaphoric Contracts} + +@(define the-eval (make-base-eval)) +@(the-eval '(require unstable/poly-c scheme/contract)) + +@defmodule[unstable/poly-c] + +@author[@author+email["Sam Tobin-Hochstadt" "samth@ccs.neu.edu"] + @author+email["Carl Eastlund" "cce@ccs.neu.edu" #:obfuscate? #t]] + + +@defform[(poly/c ([id+ id-] ...) cnt)]{ +Creates an ``anaphoric'' contract, using the @scheme[id+ ...] as the +positive positions, and the @scheme[id- ...] as the negative positions. + +Anaphoric contracts verify that only values provided to a given +positive position flow out of the corresponding negative position. + +@examples[#:eval the-eval +(define/contract (f x) (poly/c ([in out]) (in . -> . out)) + (if (equal? x 17) 18 x)) +(f 1) +(f #f) +(f 17) +] +} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index ea345570f8..0213da2679 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -80,6 +80,8 @@ Keep documentation and tests up to date. @include-section["string.scrbl"] @include-section["struct.scrbl"] @include-section["syntax.scrbl"] +@include-section["poly-c.scrbl"] +@include-section["mutated-vars.scrbl"] @;{--------}