From a4600be4059d61fac8a7ea2917b0fb3e8c6b14a4 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 25 Aug 2011 18:59:23 -0400 Subject: [PATCH] Repair type of `find-relative-path'. original commit: 717476f84df4927cdb2e2ae012ddd3c621892f38 --- collects/typed-scheme/base-env/base-env.rkt | 1 - collects/typed-scheme/base-env/base-special-env.rkt | 9 +++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index a2fceeae..5396bd39 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -1539,7 +1539,6 @@ ;; scheme/path [explode-path (-SomeSystemPathlike . -> . (-lst (Un -SomeSystemPath (one-of/c 'up 'same))))] -[find-relative-path (-SomeSystemPathlike -SomeSystemPathlike . -> . -SomeSystemPath)] [simple-form-path (-Pathlike . -> . -Path)] [normalize-path (cl->* (-Pathlike [-Pathlike] . ->opt . -Path))] [filename-extension (-SomeSystemPathlike . -> . (-opt -Bytes))] diff --git a/collects/typed-scheme/base-env/base-special-env.rkt b/collects/typed-scheme/base-env/base-special-env.rkt index 99b52934..37eb3923 100644 --- a/collects/typed-scheme/base-env/base-special-env.rkt +++ b/collects/typed-scheme/base-env/base-special-env.rkt @@ -5,9 +5,9 @@ "../utils/utils.rkt" racket/promise string-constants/string-constant - racket/private/kw racket/file racket/port syntax/parse + racket/private/kw racket/file racket/port syntax/parse racket/path (for-template (only-in racket/private/kw kw-expander-proc kw-expander-impl) - racket/base racket/promise racket/file racket/port string-constants/string-constant) + racket/base racket/promise racket/file racket/port racket/path string-constants/string-constant) (utils tc-utils) (env init-envs) (except-in (rep filter-rep object-rep type-rep) make-arr) @@ -489,4 +489,9 @@ (-lst Univ) (-opt -Output-Port) -Boolean . -> . -Void)] + ; [find-relative-path (-SomeSystemPathlike -SomeSystemPathlike . -> . -SomeSystemPath)] + [((kw-expander-proc (syntax-local-value #'find-relative-path))) + (-SomeSystemPathlike -SomeSystemPathlike #:more-than-root? Univ #f . ->key . -SomeSystemPath)] + [((kw-expander-impl (syntax-local-value #'find-relative-path))) + (Univ -Boolean -SomeSystemPathlike -SomeSystemPathlike . -> . -SomeSystemPath)] )