fixed code that relied on broken behavior of provide/contract
svn: r383
This commit is contained in:
parent
86152a3d0f
commit
5072476095
|
@ -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)
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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?))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user