Remove testing code, and failed experiment.
This commit is contained in:
Sam Tobin-Hochstadt
parent
3348ea1ae2
commit
c8380b94e5
|
|
@ -233,19 +233,6 @@
|
|||
(combine-frees (map free-idxs* (cons dty rs))))]
|
||||
[#:fold-rhs (*ValuesDots (map type-rec-id rs) (type-rec-id dty) dbound)])
|
||||
|
||||
;; lazy-arr is NOT a Type
|
||||
(def-type lazy-arr ([mand (listof Type/c)]
|
||||
[opt (listof Type/c)]
|
||||
[rng (or/c Values? ValuesDots?)]
|
||||
[rest (or/c #f Type/c)]
|
||||
[drest #f] ;; to be extended later
|
||||
[kws (listof Keyword?)])
|
||||
[#:intern (list (map Rep-seq mand) (map Rep-seq opt) (Rep-seq rng) (and rest (Rep-seq rest))
|
||||
(and drest (cons (Rep-seq (car drest)) (cdr drest)))
|
||||
(map Rep-seq kws))]
|
||||
[#:frees (λ _ (int-err "lazy-arr frees"))]
|
||||
[#:fold-rhs (int-err "lazy-arr fold")])
|
||||
|
||||
;; arr is NOT a Type
|
||||
(def-type arr ([dom (listof Type/c)]
|
||||
[rng (or/c Values? ValuesDots?)]
|
||||
|
|
|
|||
|
|
@ -85,443 +85,3 @@
|
|||
[_ (int-err 'kw-convert "non-function type" ft)]))
|
||||
|
||||
(provide kw-convert)
|
||||
|
||||
#|
|
||||
(define pre
|
||||
(list
|
||||
(->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String)
|
||||
(->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Bytes)
|
||||
(->key -Pathlike #:mode (one-of/c 'binary 'text) #f Univ)
|
||||
(->key
|
||||
-Pathlike
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
#:line-mode
|
||||
(one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)
|
||||
#f
|
||||
(-lst -String))
|
||||
(->key
|
||||
-Pathlike
|
||||
#:line-mode
|
||||
(one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
(-lst -Bytes))
|
||||
(->key
|
||||
Univ
|
||||
-Pathlike
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
-Void)
|
||||
(->key
|
||||
(-lst Univ)
|
||||
-Pathlike
|
||||
#:separator
|
||||
Univ
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)
|
||||
#f
|
||||
-Void)
|
||||
(->key
|
||||
Univ
|
||||
-Pathlike
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
-Void)
|
||||
(-poly
|
||||
(a)
|
||||
(cl->*
|
||||
(->optkey -Pathlike [(-> -Input-Port a)] #:mode (one-of/c 'binary 'text) #f (-lst a))
|
||||
(->optkey -Pathlike [(-> -Input-Port Univ)] #:mode (one-of/c 'binary 'text) #f (-lst Univ))))
|
||||
(let ((use-lock-type Univ) (timeout-lock-there-type (-opt (-> -Path Univ))) (lock-there-type (-opt (-> -Path Univ))))
|
||||
(cl->*
|
||||
(->key
|
||||
-Symbol
|
||||
#:use-lock?
|
||||
use-lock-type
|
||||
#f
|
||||
#:timeout-lock-there
|
||||
timeout-lock-there-type
|
||||
#f
|
||||
#:lock-there
|
||||
lock-there-type
|
||||
#f
|
||||
Univ)
|
||||
(->key
|
||||
-Symbol
|
||||
(-> Univ)
|
||||
#:use-lock?
|
||||
use-lock-type
|
||||
#f
|
||||
#:timeout-lock-there
|
||||
timeout-lock-there-type
|
||||
#f
|
||||
#:lock-there
|
||||
lock-there-type
|
||||
#f
|
||||
Univ)
|
||||
(->key
|
||||
-Symbol
|
||||
(-> Univ)
|
||||
Univ
|
||||
#:use-lock?
|
||||
use-lock-type
|
||||
#f
|
||||
#:timeout-lock-there
|
||||
timeout-lock-there-type
|
||||
#f
|
||||
#:lock-there
|
||||
lock-there-type
|
||||
#f
|
||||
Univ)
|
||||
(->key
|
||||
-Symbol
|
||||
(-> Univ)
|
||||
Univ
|
||||
(-opt -Pathlike)
|
||||
#:use-lock?
|
||||
use-lock-type
|
||||
#f
|
||||
#:timeout-lock-there
|
||||
timeout-lock-there-type
|
||||
#f
|
||||
#:lock-there
|
||||
lock-there-type
|
||||
#f
|
||||
Univ)))
|
||||
(let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real))
|
||||
(cl->*
|
||||
(->key -Real -Symbol #:lock-there lock-there-type #f #:max-delay max-delay-type #f (-> -Pathlike Univ))
|
||||
(->key -Real -Symbol (-> Univ) #:lock-there lock-there-type #f #:max-delay max-delay-type #f (-> -Pathlike Univ))
|
||||
(->key -Real -Symbol (-> Univ) Univ #:lock-there lock-there-type #f #:max-delay max-delay-type #f (-> -Pathlike Univ))
|
||||
(->key
|
||||
-Real
|
||||
-Symbol
|
||||
(-> Univ)
|
||||
Univ
|
||||
(-opt -Pathlike)
|
||||
#:lock-there
|
||||
lock-there-type
|
||||
#f
|
||||
#:max-delay
|
||||
max-delay-type
|
||||
#f
|
||||
(-> -Pathlike Univ))))
|
||||
(-poly
|
||||
(a)
|
||||
(->key
|
||||
(-opt -Pathlike)
|
||||
(one-of/c 'shared 'exclusive)
|
||||
(-> a)
|
||||
(-> a)
|
||||
#:lock-file
|
||||
(-opt -Pathlike)
|
||||
#f
|
||||
#:delay
|
||||
-Real
|
||||
#f
|
||||
#:max-delay
|
||||
-Real
|
||||
#f
|
||||
a))
|
||||
(-poly
|
||||
(a b)
|
||||
(cl->*
|
||||
(->key (-lst a) (-> a a -Boolean) #:key (-> a a) #f #:cache-keys? -Boolean #f (-lst a))
|
||||
(->key (-lst a) (-> b b -Boolean) #:key (-> a b) #f #:cache-keys? -Boolean #f (-lst a))))
|
||||
(-poly
|
||||
(a b)
|
||||
(cl->*
|
||||
(->optkey (-lst a) [(-> a a Univ)] #:key (-> a a) #f (-lst a))
|
||||
(->optkey (-lst a) [(-> b b Univ)] #:key (-> a b) #f (-lst a))))
|
||||
(->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Input-Port)
|
||||
(->key
|
||||
-Pathlike
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)
|
||||
#f
|
||||
-Output-Port)
|
||||
(->key
|
||||
-Pathlike
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)
|
||||
#f
|
||||
(-values (list -Input-Port -Output-Port)))
|
||||
(-poly (a) (->key -Pathlike (-> -Input-Port a) #:mode (Un (-val 'binary) (-val 'text)) #f a))
|
||||
(-poly
|
||||
(a)
|
||||
(->key
|
||||
-Pathlike
|
||||
(-> -Output-Port a)
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace 'can-update 'must-truncate)
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
a))
|
||||
(-poly (a) (->key -Pathlike (-> -Input-Port a) #:mode (Un (-val 'binary) (-val 'text)) #f a))
|
||||
(-poly
|
||||
(a)
|
||||
(->key
|
||||
-Pathlike
|
||||
(-> -Output-Port a)
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace 'can-update 'must-truncate)
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
a))
|
||||
(-poly (a) (->key -Pathlike (-> a) #:mode (Un (-val 'binary) (-val 'text)) #f a))
|
||||
(-poly
|
||||
(a)
|
||||
(->key
|
||||
-Pathlike
|
||||
(-> a)
|
||||
#:exists
|
||||
(one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)
|
||||
#f
|
||||
#:mode
|
||||
(one-of/c 'binary 'text)
|
||||
#f
|
||||
a))
|
||||
(cl->*
|
||||
(->key #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String))
|
||||
(->key -Input-Port #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String)))
|
||||
(cl->*
|
||||
(->key #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes))
|
||||
(->key -Input-Port #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes)))
|
||||
(cl->* (->key (-lst Univ) #:separator Univ #f -Void) (->key (-lst Univ) -Output-Port #:separator Univ #f -Void))
|
||||
(->key -SomeSystemPathlike -SomeSystemPathlike #:more-than-root? Univ #f -SomeSystemPath)
|
||||
(let ((N -Integer)
|
||||
(?N (-opt -Integer))
|
||||
(-StrRx (Un -String -Regexp))
|
||||
(-BtsRx (Un -Bytes -Byte-Regexp))
|
||||
(-StrInput (Un -String -Path))
|
||||
(-BtsInput (Un -Input-Port -Bytes))
|
||||
(sel (λ (t) (-opt (-> (-lst t) t)))))
|
||||
(cl->*
|
||||
(->optkey -StrRx -StrInput (N ?N -Bytes)
|
||||
#:match-select (sel -String) #f #:gap-select Univ #f
|
||||
(-lst -String))
|
||||
(->optkey -BtsRx (Un -StrInput -BtsInput) (N ?N -Bytes)
|
||||
#:match-select (sel -Bytes) #f #:gap-select Univ #f
|
||||
(-lst -Bytes))
|
||||
(->optkey -Pattern -BtsInput (N ?N -Bytes)
|
||||
#:match-select (sel -Bytes) #f #:gap-select Univ #f
|
||||
(-lst -Bytes))))
|
||||
(let* ((?outp (-opt -Output-Port))
|
||||
(B -Boolean)
|
||||
(N -Integer)
|
||||
(?N (-opt -Integer))
|
||||
(ind-pair (-pair -Index -Index))
|
||||
(sel (-> (-lst (-opt ind-pair)) (-opt ind-pair)))
|
||||
(output (-opt (-pair ind-pair (-lst (-opt ind-pair)))))
|
||||
(-Input (Un -String -Input-Port -Bytes -Path)))
|
||||
(->optkey -Pattern -Input [N ?N -Bytes] #:match-select sel #f output))))
|
||||
|
||||
(define post
|
||||
(list (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike -String)
|
||||
(-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike -Bytes)
|
||||
(-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike Univ)
|
||||
(->
|
||||
(Un (-val #f) (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one))
|
||||
-Boolean
|
||||
(Un (-val #f) (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
(-lst -String))
|
||||
(->
|
||||
(Un (-val #f) (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one))
|
||||
-Boolean
|
||||
(Un (-val #f) (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
(-lst -Bytes))
|
||||
(->
|
||||
(Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(Un (-val #f) (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
Univ
|
||||
-Pathlike
|
||||
-Void)
|
||||
(->
|
||||
(Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(Un (-val #f) (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
(Un (-val #f) Univ)
|
||||
-Boolean
|
||||
(-lst Univ)
|
||||
-Pathlike
|
||||
-Void)
|
||||
(->
|
||||
(Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(Un (-val #f) (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
Univ
|
||||
-Pathlike
|
||||
-Void)
|
||||
(-poly
|
||||
(a)
|
||||
(cl->*
|
||||
(-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) (-val #t) (-lst a))
|
||||
(-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike Univ -Boolean (-lst Univ))))
|
||||
(let ((use-lock-type Univ) (timeout-lock-there-type (-opt (-> -Path Univ))) (lock-there-type (-opt (-> -Path Univ))))
|
||||
(->
|
||||
(-opt lock-there-type)
|
||||
-Boolean
|
||||
(-opt timeout-lock-there-type)
|
||||
-Boolean
|
||||
(-opt use-lock-type)
|
||||
-Boolean
|
||||
-Symbol
|
||||
(-opt (-> Univ))
|
||||
(-opt Univ)
|
||||
(-opt (-opt -Pathlike))
|
||||
-Boolean
|
||||
-Boolean
|
||||
-Boolean
|
||||
Univ))
|
||||
(let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real))
|
||||
(->
|
||||
(-opt lock-there-type)
|
||||
-Boolean
|
||||
(-opt max-delay-type)
|
||||
-Boolean
|
||||
-Real
|
||||
-Symbol
|
||||
(-opt (-> Univ))
|
||||
(-opt Univ)
|
||||
(-opt (-opt -Pathlike))
|
||||
-Boolean
|
||||
-Boolean
|
||||
-Boolean
|
||||
(-> -Pathlike Univ)))
|
||||
(-poly
|
||||
(a)
|
||||
(->
|
||||
(-opt -Real)
|
||||
-Boolean
|
||||
(-opt (-opt -Pathlike))
|
||||
-Boolean
|
||||
(-opt -Real)
|
||||
-Boolean
|
||||
(-opt -Pathlike)
|
||||
(one-of/c 'shared 'exclusive)
|
||||
(-> a)
|
||||
(-> a)
|
||||
a))
|
||||
(-poly
|
||||
(a b)
|
||||
(cl->*
|
||||
(-> -Boolean -Boolean Univ (-val #f) (-lst a) (-> a a -Boolean) (-lst a))
|
||||
(-> -Boolean -Boolean (-> a b) (-val #t) (-lst a) (-> b b -Boolean) (-lst a))))
|
||||
(-poly
|
||||
(a b)
|
||||
(cl->*
|
||||
(-> Univ (-val #f) (-lst a) (-val #f) -Boolean (-lst a))
|
||||
(-> Univ (-val #f) (-lst a) (-> a a Univ) -Boolean (-lst a))
|
||||
(-> (-> a b) (-val #t) (-lst a) (-opt (-> b b Univ)) -Boolean (-lst a))))
|
||||
(-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike -Input-Port)
|
||||
(->
|
||||
(-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(-opt (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
-Output-Port)
|
||||
(->
|
||||
(-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(-opt (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
(-values (list -Input-Port -Output-Port)))
|
||||
(-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) a))
|
||||
(-poly
|
||||
(a)
|
||||
(->
|
||||
(-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(-opt (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
(-> -Output-Port a)
|
||||
a))
|
||||
(-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) a))
|
||||
(-poly
|
||||
(a)
|
||||
(->
|
||||
(-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(-opt (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
(-> -Output-Port a)
|
||||
a))
|
||||
(-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> a) a))
|
||||
(-poly
|
||||
(a)
|
||||
(->
|
||||
(-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace))
|
||||
-Boolean
|
||||
(-opt (one-of/c 'binary 'text))
|
||||
-Boolean
|
||||
-Pathlike
|
||||
(-> a)
|
||||
a))
|
||||
(-> (-opt (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean (-opt -Input-Port) -Boolean (-lst -String))
|
||||
(-> (-opt (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean (-opt -Input-Port) -Boolean (-lst -Bytes))
|
||||
(-> (-opt Univ) -Boolean (-lst Univ) (-opt -Output-Port) -Boolean -Void)
|
||||
(-> Univ -Boolean -SomeSystemPathlike -SomeSystemPathlike -SomeSystemPath)
|
||||
(let ((N -Integer)
|
||||
(B -Boolean)
|
||||
(?N (-opt -Integer))
|
||||
(-StrRx (Un -String -Regexp))
|
||||
(-BtsRx (Un -Bytes -Byte-Regexp))
|
||||
(-StrInput (Un -String -Path))
|
||||
(sel (λ (t) (-opt (-> (-lst t) t))))
|
||||
(-BtsInput (Un -Input-Port -Bytes)))
|
||||
(cl->*
|
||||
(-> Univ B (sel -String) B -StrRx -StrInput
|
||||
(-opt N) (-opt ?N) (-opt -Bytes) B B B (-lst -String))
|
||||
(-> Univ B (sel -Bytes) B -BtsRx (Un -StrInput -BtsInput)
|
||||
(-opt N) (-opt ?N) (-opt -Bytes) B B B (-lst -Bytes))
|
||||
(-> Univ B (sel -Bytes) B -Pattern -BtsInput
|
||||
(-opt N) (-opt ?N) (-opt -Bytes) B B B (-lst -Bytes))))
|
||||
|
||||
(let* ([?outp (-opt -Output-Port)]
|
||||
[B -Boolean]
|
||||
[N -Integer]
|
||||
[?N (-opt -Integer)]
|
||||
[ind-pair (-pair -Index -Index)]
|
||||
[output (-opt (-pair ind-pair (-lst (-opt ind-pair))))]
|
||||
(sel (-> (-lst (-opt ind-pair)) (-opt ind-pair)))
|
||||
[-Input (Un -String -Input-Port -Bytes -Path)])
|
||||
(-> (-opt sel) B -Pattern -Input (-opt N) (-opt ?N) (-opt -Bytes) B B B output))))
|
||||
|#
|
||||
Loading…
Reference in New Issue
Block a user