fixed code that relied on broken behavior of provide/contract

svn: r383
This commit is contained in:
Robby Findler 2005-07-16 14:03:55 +00:00
parent 86152a3d0f
commit 5072476095
8 changed files with 35 additions and 50 deletions

View File

@ -9,6 +9,7 @@
(lib "string.ss")
(lib "port.ss")
(lib "url-sig.ss" "net")
(lib "url-structs.ss" "net")
(only (lib "html.ss" "html") read-html-as-xml)
(only (lib "html.ss" "html") read-html-comments)
(only (lib "html.ss" "html") use-html-spec)

View File

@ -38,6 +38,7 @@ A test case:
(lib "string.ss")
(lib "etc.ss")
(lib "url-sig.ss" "net")
(lib "url-structs.ss" "net")
(lib "head.ss" "net")
(lib "mred-sig.ss" "mred")
(lib "framework.ss" "framework")

View File

@ -3,6 +3,15 @@
(lib "contract.ss")
(lib "list.ss"))
;; a move is either:
;; - (make-enter-piece pawn)
;; - (make-move-piece-main pawn start distance)
;; - (make-move-piece-home pawn start distance)
(define-struct move () (make-inspector))
(define-struct (enter-piece move) (pawn) (make-inspector))
(define-struct (move-piece-main move) (pawn start distance) (make-inspector))
(define-struct (move-piece-home move) (pawn start distance) (make-inspector))
(provide/contract
(struct enter-piece ((pawn pawn?)))
(struct move-piece-main ([pawn pawn?] [start number?] [distance number?]))
@ -36,15 +45,6 @@
(define bop-bonus 20)
(define home-bonus 10)
;; a move is either:
;; - (make-enter-piece pawn)
;; - (make-move-piece-main pawn start distance)
;; - (make-move-piece-home pawn start distance)
(define-struct move () (make-inspector))
(define-struct (enter-piece move) (pawn) (make-inspector))
(define-struct (move-piece-main move) (pawn start distance) (make-inspector))
(define-struct (move-piece-home move) (pawn start distance) (make-inspector))
;; moves-dice : moves -> (listof number)
;; does not return the die moves that correspond to entering pawns

View File

@ -14,6 +14,7 @@
(lib "browser-sig.ss" "browser")
(lib "url-sig.ss" "net")
(lib "url-structs.ss" "net")
"sig.ss"
"../bug-report.ss"
(lib "bday.ss" "framework" "private")

View File

@ -6,6 +6,7 @@
(lib "sig.ss" "web-server")
(lib "tcp-sig.ss" "net")
(lib "url-sig.ss" "net")
(lib "url-structs.ss" "net")
"internal-hp.ss")
(define-syntax (redefine stx)
@ -33,35 +34,18 @@
[(and (equal? (url-port url) internal-port)
(equal? (url-host url) internal-host))
(let* ([long
(raw:url->string
(raw:make-url ""
(raw:url-user url)
""
#f
(raw:url-path url)
(raw:url-query url)
(raw:url-fragment url)))])
(url->string
(make-url ""
(url-user url)
""
#f
(url-path url)
(url-query url)
(url-fragment url)))])
(substring long 3 (string-length long)))]
[else (raw:url->string url)]))
(redefine make-url
struct:url
url-scheme set-url-scheme!
url-user set-url-user!
url-host set-url-host!
url-port set-url-port!
url-path set-url-path!
url-query set-url-query!
url-fragment set-url-fragment!
url?
struct:path/param
make-path/param
path/param-path set-path/param-path!
path/param-param set-path/param-param!
path/param?
get-pure-port
(redefine get-pure-port
get-impure-port
post-pure-port
post-impure-port

View File

@ -3,9 +3,7 @@
(provide net:url^)
(define-signature net:url^
((struct url (scheme user host port path query fragment))
(struct path/param (path param))
get-pure-port
(get-pure-port
get-impure-port
post-pure-port
post-impure-port

View File

@ -13,6 +13,7 @@
(require (lib "file.ss")
(lib "unitsig.ss")
(lib "port.ss")
"url-structs.ss"
"uri-codec.ss"
"url-sig.ss"
"tcp-sig.ss")
@ -60,9 +61,6 @@
args)))))
(raise (make-url-exception s (current-continuation-marks))))))
(define-struct url (scheme user host port path query fragment))
(define-struct path/param (path param))
(define url->string
(lambda (url)
(let ((scheme (url-scheme url))

View File

@ -1,6 +1,7 @@
(module url mzscheme
(require (lib "unitsig.ss")
(lib "contract.ss")
"url-struct.ss"
"url-sig.ss"
"url-unit.ss"
"tcp-sig.ss"
@ -15,16 +16,17 @@
[U : net:url^ (url@ T)])
(export (open U))))
(provide
(struct url (scheme
user
host
port
path
query
fragment))
(struct path/param (path param)))
(provide/contract
(struct url ([scheme (union false/c string?)]
[user (union false/c string?)]
[host (union false/c string?)]
[port (union false/c number?)]
[path (listof (union string? path/param?))]
[query (listof (cons/c symbol? string?))]
[fragment (union false/c string?)]))
(struct path/param ([path string?]
[param string?]))
(string->url ((union bytes? string?) . -> . url?))
(url->string (url? . -> . string?))