suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add remaining racket/list functions to TR base-env

Browse Source
This commit is contained in:
Asumu Takikawa 2014-04-23 18:41:23 -04:00
parent 7624356774
commit d731a02fa5
2 changed files with 48 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt
View File

@ -614,11 +614,43 @@
[last-pair (-poly (a) ((-mu x (Un a (-val '()) (-pair a x))) [last-pair (-poly (a) ((-mu x (Un a (-val '()) (-pair a x)))
. -> . . -> .
(Un (-pair a a) (-pair a (-val '())))))] (Un (-pair a a) (-pair a (-val '())))))]
[takef
(-poly (a b)
(cl->*
(-> (-lst a)
(asym-pred a Univ (-FS (-filter b 0) -top))
(-lst b))
(-> (-lst a) (-> a Univ) (-lst a))))]
[dropf (-poly (a) (-> (-lst a) (-> a Univ) (-lst a)))]
[splitf-at
(-poly (a b)
(cl->*
(-> (-lst a)
(asym-pred a Univ (-FS (-filter b 0) -top))
(-values (list (-lst b) (-lst a))))
(-> (-lst a) (-> a Univ) (-values (list (-lst a) (-lst a))))))]
[takef-right
(-poly (a b)
(cl->*
(-> (-lst a)
(asym-pred a Univ (-FS (-filter b 0) -top))
(-lst b))
(-> (-lst a) (-> a Univ) (-lst a))))]
[dropf-right (-poly (a) (-> (-lst a) (-> a Univ) (-lst a)))]
[splitf-at-right
(-poly (a b)
(cl->*
(-> (-lst a)
(asym-pred a Univ (-FS (-filter b 0) -top))
(-values (list (-lst a) (-lst b))))
(-> (-lst a) (-> a Univ) (-values (list (-lst a) (-lst a))))))]
[append-map [append-map
(-polydots (c a b) ((list ((list a) (b b) . ->... . (-lst c)) (-lst a)) (-polydots (c a b) ((list ((list a) (b b) . ->... . (-lst c)) (-lst a))
((-lst b) b) . ->... .(-lst c)))] ((-lst b) b) . ->... .(-lst c)))]
[append* [append*
(-poly (a) ((-lst (-lst a)) . -> . (-lst a)))] (-poly (a) ((-lst (-lst a)) . -> . (-lst a)))]
[permutations (-poly (a) (-> (-lst a) (-lst (-lst a))))]
[in-permutations (-poly (a) (-> (-lst a) (-seq (-lst a))))]
[argmin (-poly (a) ((a . -> . -Real) (-lst a) . -> . a))] [argmin (-poly (a) ((a . -> . -Real) (-lst a) . -> . a))]
[argmax (-poly (a) ((a . -> . -Real) (-lst a) . -> . a))] [argmax (-poly (a) ((a . -> . -Real) (-lst a) . -> . a))]

16
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2086,6 +2086,22 @@
[tc-e (remq* '(1 2) '(a b c d)) (-lst (one-of/c 'a 'b 'c 'd))] [tc-e (remq* '(1 2) '(a b c d)) (-lst (one-of/c 'a 'b 'c 'd))]
[tc-e (remv* '(1 2) '(a b c d)) (-lst (one-of/c 'a 'b 'c 'd))] [tc-e (remv* '(1 2) '(a b c d)) (-lst (one-of/c 'a 'b 'c 'd))]
;; functions from racket/list
[tc-e (takef '(a b "x" "y") symbol?) (-lst -Symbol)]
[tc-e (takef-right '(a b "x" "y") string?) (-lst -String)]
[tc-e (dropf '("a" b "x" "y") string?)
(-lst (t:Un -String (-val 'b)))]
[tc-e (dropf-right '("a" b "x" "y") string?)
(-lst (t:Un -String (-val 'b)))]
[tc-e (splitf-at '("a" b "x" "y") string?)
#:ret (ret (list (-lst -String)
(-lst (t:Un -String (-val 'b)))))]
[tc-e (splitf-at-right '("a" b "x" "y") string?)
#:ret (ret (list (-lst (t:Un -String (-val 'b)))
(-lst -String)))]
[tc-e (permutations '(a b c d)) (-lst (-lst (one-of/c 'a 'b 'c 'd)))]
[tc-e (in-permutations '(a b c d)) (-seq (-lst (one-of/c 'a 'b 'c 'd)))]
;; test functions which do lookup with the "wrong type", where the ;; test functions which do lookup with the "wrong type", where the
;; result type shouldn't be widened to include that type ;; result type shouldn't be widened to include that type
[tc-e (memq 3 '(a b c)) (t:Un (-val #f) (-lst (one-of/c 'a 'b 'c)))] [tc-e (memq 3 '(a b c)) (t:Un (-val #f) (-lst (one-of/c 'a 'b 'c)))]