From 04e1cb701f48484298ed5b1149bb13cd730f9dea Mon Sep 17 00:00:00 2001
From: ben <benjaminlgreenman@gmail.com>
Date: Tue, 22 Mar 2016 21:25:12 -0400
Subject: [PATCH] [bg] more lists, sorting, CPS

---
 tapl/tests/mlish/bg/README.md    |  66 ++--
 tapl/tests/mlish/bg/basics.mlish | 557 +++++++++++++++++++++++++++++++
 tapl/tests/mlish/bg/ps1.mlish    | 248 --------------
 3 files changed, 600 insertions(+), 271 deletions(-)
 create mode 100644 tapl/tests/mlish/bg/basics.mlish
 delete mode 100644 tapl/tests/mlish/bg/ps1.mlish

diff --git a/tapl/tests/mlish/bg/README.md b/tapl/tests/mlish/bg/README.md
index b1f6128..4a56998 100644
--- a/tapl/tests/mlish/bg/README.md
+++ b/tapl/tests/mlish/bg/README.md
@@ -3,26 +3,46 @@ bg
 
 mlish tests by Ben
 
-- `ps1` : 
-  ```
-  (define (fn-list [f* : (List (→ A A))] [a : A] → A)
-  (define (count-letters/one [s : String] [c : Char] → Int)
-  (define (count-letters [s* : (List String)] [c : Char] → Int)
-  (define (map [f : (→ A B)] [x* : (List A)] → (List B))
-  (define (append [x* : (List A)] [y* : (List A)] → (List A))
-  (define (flatten [x** : (List (List A))] → (List A))
-  (define (insert [x : A] → (→ (List A) (List (List A))))
-  (define (permutations [x* : (List A)] → (List (List A)))
-  (define (split [ab* : (List (** A B))] → (** (List A) (List B)))
-  (define (combine [a*b* : (** (List A) (List B))] → (List (** A B)))
-  (define (fst [xy : (** A B)] → A)
-  (define (snd [xy : (** A B)] → B)
-  (define (foldl [f : (→ A B A)] [acc : A] [x* : (List B)] → A)
-  (define (sum [x* : (List Float)] → Float)
-  (define (reverse [x* : (List A)] → (List A))
-  (define (convolve [x* : (List Float)] [y* : (List Float)] → Float)
-  (define (mc [n : Int] [f : (→ A A)] [x : A] → A)
-  (define (square [n : Int] → Int)
-  (define (successor [mcn : (→ (→ A A) A A)] → (→ (→ A A) A A))
-  ```
-- 
+`basics`
+---
+```
+(fn-list [f* : (List (→ A A))] [a : A] → A)
+(count-letters/one [s : String] [c : Char] → Int)
+(count-letters [s* : (List String)] [c : Char] → Int)
+(map [f : (→ A B)] [x* : (List A)] → (List B))
+(append [x* : (List A)] [y* : (List A)] → (List A))
+(flatten [x** : (List (List A))] → (List A))
+(insert [x : A] → (→ (List A) (List (List A))))
+(permutations [x* : (List A)] → (List (List A)))
+(split [ab* : (List (** A B))] → (** (List A) (List B)))
+(combine [a*b* : (** (List A) (List B))] → (List (** A B)))
+(fst [xy : (** A B)] → A)
+(snd [xy : (** A B)] → B)
+(member [x* : (List A)] [y : A] → Bool)
+(foldl [f : (→ A B A)] [acc : A] [x* : (List B)] → A)
+(foldr [f : (→ A B B)] [x* : (List A)] [acc : B] → B)
+(filter [f : (→ A Bool)] [x* : (List A)] → (List A))
+(sum [x* : (List Float)] → Float)
+(reverse [x* : (List A)] → (List A))
+(convolve [x* : (List Float)] [y* : (List Float)] → Float)
+(mc [n : Int] [f : (→ A A)] [x : A] → A)
+(square [n : Int] → Int)
+(successor [mcn : (→ (→ A A) A A)] → (→ (→ A A) A A))
+(map-index [is* : (List (** Int (List String)))] → (List (** String Int)))
+(reduce-index [si* : (List (** String Int))] → (List (** String (List Int))))
+(make-index [is* : (List (** Int (List String)))] → (List (** String (List Int))))
+(split [x* : (List A)] → (** (List A) (List A)))
+(merge [x*+y* : (** (List Int) (List Int))] → (List Int))
+(mergesort {x* : (List Int)} → (List Int))
+(quicksort [x* : (List Int)] → (List Int))
+(fact [n : Int] → Int)
+(range-aux [n : Int] → (List Int))
+(range [n : Int] → (List Int))
+(fact-acc [n : Int] → Int)
+(fact-cps-aux [n : Int] [k : (→ Int Int)] → Int)
+(fact-cps [n : Int] → Int)
+(map-cps-aux [f : (→ A B)] [x* : (List A)] [k : (→ (List B) (List B))] → (List B))
+(map-cps [f : (→ A B)] [x* : (List A)] → (List B))
+```
+
+
diff --git a/tapl/tests/mlish/bg/basics.mlish b/tapl/tests/mlish/bg/basics.mlish
new file mode 100644
index 0000000..b0aebb5
--- /dev/null
+++ b/tapl/tests/mlish/bg/basics.mlish
@@ -0,0 +1,557 @@
+#lang s-exp "../../../mlish.rkt"
+(require "../../rackunit-typechecking.rkt")
+
+;; =============================================================================
+
+(define-type (List X)
+  Nil
+  (Cons X (List X)))
+
+;; =============================================================================
+;; http://www.cs.cornell.edu/courses/cs3110/2011fa/hw/ps1/ps1.html
+
+(define (fn-list [f* : (List (→ A A))] [a : A] → A)
+  (match f* with
+   [Nil -> a]
+   [Cons f f* -> (fn-list f* (f a))]))
+
+(check-type
+  (fn-list (Cons (λ ([x : Int]) (+ x 1)) (Cons (λ ([x : Int]) (* x 2)) Nil)) 4)
+  : Int
+  ⇒ 10)
+
+;; -----------------------------------------------------------------------------
+
+(define (count-letters/one [s : String] [c : Char] → Int)
+  (for/sum ([i (in-range (string-length s))])
+    (if (equal? (string-ref s i) c)
+      1
+      0)))
+
+(define (count-letters [s* : (List String)] [c : Char] → Int)
+  (match s* with
+   [Nil -> 0]
+   [Cons s s* -> (+ (count-letters/one s c)
+                    (count-letters s* c))]))
+
+(check-type
+  (count-letters (Cons "OCaml" (Cons "Is" (Cons "Alot" (Cons "Better" (Cons "Than" (Cons "Java" Nil)))))) (string-ref "a" 0))
+  : Int
+  ⇒ 4)
+
+;; -----------------------------------------------------------------------------
+
+(define (map [f : (→ A B)] [x* : (List A)] → (List B))
+  (match x* with
+   [Nil -> Nil]
+   [Cons x x* -> (Cons (f x) (map f x*))]))
+
+(define (append [x* : (List A)] [y* : (List A)] → (List A))
+  (match x* with
+   [Nil -> y*]
+   [Cons x x* -> (Cons x (append x* y*))]))
+
+(define (flatten [x** : (List (List A))] → (List A))
+  (match x** with
+   [Nil -> Nil]
+   [Cons x* x** -> (append x* (flatten x**))]))
+
+(define (insert [x : A] → (→ (List A) (List (List A))))
+  (λ ([x* : (List A)])
+    (Cons (Cons x x*)
+      (match x* with
+       [Nil -> Nil]
+       [Cons y y* -> (map (λ ([z* : (List A)]) (Cons y z*))
+                          ((insert x) y*))]))))
+
+(define (permutations [x* : (List A)] → (List (List A)))
+  (match x* with
+   [Nil -> (Cons Nil Nil)]
+   [Cons x x* -> (flatten (map (insert x) (permutations x*)))]))
+
+(check-type
+  (permutations (Nil {Int}))
+  : (List (List Int))
+  ⇒ (Cons (Nil {(List Int)}) Nil))
+
+(check-type
+  (permutations (Cons 1 Nil))
+  : (List (List Int))
+  ⇒ (Cons (Cons 1 Nil) Nil))
+
+(check-type
+  (permutations (Cons 1 (Cons 2 Nil)))
+  : (List (List Int))
+  ⇒ (Cons (Cons 1 (Cons 2 Nil)) (Cons (Cons 2 (Cons 1 Nil)) Nil)))
+
+(check-type
+  (permutations (Cons 1 (Cons 2 (Cons 3 Nil))))
+  : (List (List Int))
+  ⇒ (Cons (Cons 1 (Cons 2 (Cons 3 Nil)))
+    (Cons (Cons 2 (Cons 1 (Cons 3 Nil)))
+    (Cons (Cons 2 (Cons 3 (Cons 1 Nil)))
+    (Cons (Cons 1 (Cons 3 (Cons 2 Nil)))
+    (Cons (Cons 3 (Cons 1 (Cons 2 Nil)))
+    (Cons (Cons 3 (Cons 2 (Cons 1 Nil)))
+    Nil)))))))
+
+;; =============================================================================
+;; http://www.cs.cornell.edu/courses/cs3110/2011sp/hw/ps1/ps1.htm
+
+(define-type (** X Y)
+  (Pair X Y))
+
+(define (split [ab* : (List (** A B))] → (** (List A) (List B)))
+  (match ab* with
+   [Nil -> (Pair Nil Nil)]
+   [Cons ab ab* ->
+    (match ab with
+     [Pair a b ->
+      (match (split ab*) with
+       [Pair a* b* ->
+        (Pair (Cons a a*)
+              (Cons b b*))])])]))
+
+(check-type
+  (split (Nil {(** Int Int)}))
+  : (** (List Int) (List Int))
+  ⇒ (Pair (Nil {Int}) (Nil {Int})))
+
+(check-type
+  (split (Cons (Pair 1 2) (Cons (Pair 3 4) Nil)))
+  : (** (List Int) (List Int))
+  ⇒ (Pair (Cons 1 (Cons 3 Nil))
+          (Cons 2 (Cons 4 Nil))))
+
+(check-type
+  (split (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil))))
+  : (** (List Int) (List String))
+  ⇒ (Pair (Cons 1 (Cons 2 (Cons 3 Nil)))
+          (Cons "one" (Cons "two" (Cons "three" Nil)))))
+
+;; -----------------------------------------------------------------------------
+
+(define (combine [a*b* : (** (List A) (List B))] → (List (** A B)))
+  (match a*b* with
+   [Pair a* b* ->
+    (match a* with
+     [Nil ->
+      (match b* with
+       [Nil ->
+        Nil]
+       [Cons b b* ->
+        Nil])] ;; Error
+     [Cons a a* ->
+      (match b* with
+       [Nil ->
+        Nil] ;; Error
+       [Cons b b* ->
+        (Cons (Pair a b) (combine (Pair a* b*)))])])]))
+
+(check-type
+  (combine (Pair (Nil {Int}) (Nil {Int})))
+  : (List (** Int Int))
+  ⇒ (Nil {(** Int Int)}))
+
+(check-type
+  (combine (Pair (Cons 1 (Cons 2 Nil)) (Cons 3 (Cons 4 Nil))))
+  : (List (** Int Int))
+  ⇒ (Cons (Pair 1 3) (Cons (Pair 2 4) Nil)))
+
+(check-type
+  (combine (split (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil)))))
+  : (List (** Int String))
+  ⇒ (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil))))
+
+;; -----------------------------------------------------------------------------
+
+(define-type Bool
+  True
+  False)
+
+(define (fst [xy : (** A B)] → A)
+  (match xy with
+   [Pair x y -> x]))
+
+(define (snd [xy : (** A B)] → B)
+  (match xy with
+   [Pair x y -> y]))
+
+(define (member [x* : (List A)] [y : A] → Bool)
+  (match x* with
+   [Nil -> False]
+   [Cons x x* ->
+    (if (equal? x y) True (member x* y))]))
+
+(define (foldl [f : (→ A B A)] [acc : A] [x* : (List B)] → A)
+  (match x* with
+   [Nil -> acc]
+   [Cons x x* -> (foldl f (f acc x) x*)]))
+
+(define (foldr [f : (→ A B B)] [x* : (List A)] [acc : B] → B)
+  (match x* with
+   [Nil -> acc]
+   [Cons x x* -> (f x (foldr f x* acc))]))
+
+(define (filter [f : (→ A Bool)] [x* : (List A)] → (List A))
+  (foldr (λ ([x : A] [acc : (List A)]) (match (f x) with [True -> (Cons x acc)] [False -> acc]))
+    x*
+    Nil))
+
+(define (sum [x* : (List Float)] → Float)
+  (foldl fl+ (exact->inexact 0) x*))
+
+(define (reverse [x* : (List A)] → (List A))
+  (foldl (λ ([x* : (List A)] [x : A]) (Cons x x*)) Nil x*))
+
+(define (convolve [x* : (List Float)] [y* : (List Float)] → Float)
+  (sum
+    (map (λ ([xy : (** Float Float)]) (fl* (fst xy) (snd xy)))
+      (combine (Pair x* (reverse y*))))))
+
+(check-type
+  (convolve (Cons 1.0 (Cons 2.0 (Cons 3.0 Nil))) (Cons 1.0 (Cons 2.0 (Cons 3.0 Nil))))
+  : Float
+  ⇒ (fl+ (fl+ (fl* 1.0 3.0) (fl* 2.0 2.0)) (fl* 3.0 1.0)))
+
+;; -----------------------------------------------------------------------------
+
+(define (mc [n : Int] [f : (→ A A)] [x : A] → A)
+  (for/fold ([x x])
+            ([_i (in-range n)])
+    (f x)))
+
+(check-type
+  (mc 3000 (λ ([n : Int]) (+ n 1)) 3110)
+  : Int
+  ⇒ 6110)
+
+(define (square [n : Int] → Int)
+  (* n n))
+
+(check-type
+  (mc 0 square 2)
+  : Int
+  ⇒ 2)
+
+(check-type
+  (mc 2 square 2)
+  : Int
+  ⇒ 16)
+
+(check-type
+  (mc 3 square 2)
+  : Int
+  ⇒ 256)
+
+;; -----------------------------------------------------------------------------
+
+(define (successor [mcn : (→ (→ A A) A A)] → (→ (→ A A) A A))
+  (λ ([f : (→ A A)] [x : A])
+    (f (mcn f x))))
+
+(check-type
+  ((successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x))) square 2)
+  : Int
+  ⇒ 4)
+
+(check-type
+  ((successor (successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x)))) square 2)
+  : Int
+  ⇒ 16)
+
+(check-type
+  ((successor (successor (successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x))))) square 2)
+  : Int
+  ⇒ 256)
+
+;; # (mc 3 successor) (mc 0) square 2;;
+
+;; -----------------------------------------------------------------------------
+
+(define (map-index [is* : (List (** Int (List String)))] → (List (** String Int)))
+  (match is* with
+   [Nil -> Nil]
+   [Cons hd tl ->
+    (match hd with
+     [Pair i s* ->
+      (append (foldr (λ ([s : String] [acc : (List (** String Int))]) (Cons (Pair s i) acc))
+                     s*
+                     Nil)
+              (map-index tl))])]))
+
+(check-type
+  (map-index Nil)
+  : (List (** String Int))
+  ⇒ (Nil {(List (** String Int))}))
+
+(check-type
+  (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil)))) Nil))
+  : (List (** String Int))
+  ⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) Nil))))
+
+(check-type
+  (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
+             (Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
+             Nil)))
+  : (List (** String Int))
+  ⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) (Cons (Pair "d" 1) (Cons (Pair "e" 1) Nil))))))
+
+(define (reduce-index [si* : (List (** String Int))] → (List (** String (List Int))))
+  (snd (foldr
+    (λ ([si : (** String Int)] [acc : (** (List String) (List (** String (List Int))))])
+      (match si with
+       [Pair s i ->
+        (match acc with
+         [Pair seen out ->
+          (match (member seen s) with
+           [True ->
+            (Pair
+              seen
+              (foldr
+                (λ ([si* : (** String (List Int))] [acc : (List (** String (List Int)))])
+                  (match si* with
+                   [Pair s2 i* ->
+                    (if (equal? s s2)
+                      (match (member i* i) with
+                       [True -> (Cons si* acc)]
+                       [False -> (Cons (Pair s2 (Cons i i*)) acc)])
+                      (Cons si* acc))]))
+                out
+                Nil))]
+           [False ->
+            (Pair
+              (Cons s seen)
+              (Cons (Pair s (Cons i Nil)) out))])])]))
+    si*
+    (Pair Nil Nil))))
+
+
+(check-type
+  (reduce-index Nil)
+  : (List (** String (List Int)))
+  ⇒ (Nil {(List (** String (List Int)))}))
+
+(check-type
+  (reduce-index
+    (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
+               (Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
+               Nil))))
+  : (List (** String (List Int)))
+  ⇒ (Cons (Pair "a" (Cons 0 Nil))
+    (Cons (Pair "b" (Cons 0 Nil))
+    (Cons (Pair "c" (Cons 0 Nil))
+    (Cons (Pair "d" (Cons 1 Nil))
+    (Cons (Pair "e" (Cons 1 Nil))
+    Nil))))))
+
+(check-type
+  (reduce-index
+    (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
+               (Cons (Pair 1 (Cons "a" (Cons "b" Nil)))
+               Nil))))
+  : (List (** String (List Int)))
+  ⇒ (Cons (Pair "c" (Cons 0 Nil))
+    (Cons (Pair "a" (Cons 0 (Cons 1 Nil)))
+    (Cons (Pair "b" (Cons 0 (Cons 1 Nil)))
+    Nil))))
+
+;; For every string, get all integers that refer to the string
+(define (make-index [is* : (List (** Int (List String)))] → (List (** String (List Int))))
+  (reduce-index (map-index is*)))
+
+(check-type
+  (make-index Nil)
+  : (List (** String (List Int)))
+  ⇒ (Nil {(List (** String (List Int)))}))
+
+(check-type
+  (make-index (Cons (Pair 1 (Cons "ocaml" (Cons "is" (Cons "fun" (Cons "because" (Cons "fun" (Cons "is" (Cons "a" (Cons "keyword" Nil)))))))))
+              (Cons (Pair 2 (Cons "page" (Cons "2" (Cons "intentionally" (Cons "left" (Cons "blank" Nil))))))
+              (Cons (Pair 3 (Cons "the" (Cons "quick" (Cons "brown" (Cons "fox" (Cons "jumped" (Cons "over" (Cons "the" (Cons "lazy" (Cons "dog" Nil))))))))))
+              (Cons (Pair 4 (Cons "is" (Cons "this" (Cons "the" (Cons "end" Nil))))) Nil)))))
+  : (List (** String (List Int)))
+  ⇒ (Cons (Pair "ocaml" (Cons 1 Nil))
+    (Cons (Pair "because" (Cons 1 Nil))
+    (Cons (Pair "fun" (Cons 1 Nil))
+    (Cons (Pair "a" (Cons 1 Nil))
+    (Cons (Pair "keyword" (Cons 1 Nil))
+    (Cons (Pair "page" (Cons 2 Nil))
+    (Cons (Pair "2" (Cons 2 Nil))
+    (Cons (Pair "intentionally" (Cons 2 Nil))
+    (Cons (Pair "left" (Cons 2 Nil))
+    (Cons (Pair "blank" (Cons 2 Nil))
+    (Cons (Pair "quick" (Cons 3 Nil))
+    (Cons (Pair "brown" (Cons 3 Nil))
+    (Cons (Pair "fox" (Cons 3 Nil))
+    (Cons (Pair "jumped" (Cons 3 Nil))
+    (Cons (Pair "over" (Cons 3 Nil))
+    (Cons (Pair "lazy" (Cons 3 Nil))
+    (Cons (Pair "dog" (Cons 3 Nil))
+    (Cons (Pair "is" (Cons 1 (Cons 4 Nil)))
+    (Cons (Pair "this" (Cons 4 Nil))
+    (Cons (Pair "the" (Cons 3 (Cons 4 Nil)))
+    (Cons (Pair "end" (Cons 4 Nil)) Nil))))))))))))))))))))))
+
+;; =============================================================================
+;; === sorting
+
+;; -----------------------------------------------------------------------------
+;; --- mergesort
+
+(define (split [x* : (List A)] → (** (List A) (List A)))
+  (match x* with
+   [Nil -> (Pair Nil Nil)]
+   [Cons h t ->
+    (match t with
+     [Nil -> (Pair (Cons h Nil) Nil)]
+     [Cons h2 x* ->
+      (match (split x*) with
+       [Pair x* y* ->
+        (Pair (Cons h x*) (Cons h2 y*))])])]))
+
+(define (merge [x*+y* : (** (List Int) (List Int))] → (List Int))
+  (match x*+y* with
+   [Pair xx* yy* ->
+    (match xx* with
+     [Nil -> yy*]
+     [Cons x x* ->
+      (match yy* with
+       [Nil -> xx*]
+       [Cons y y* ->
+        (if (<= x y)
+         (Cons x (merge (Pair x* yy*)))
+         (Cons y (merge (Pair xx* y*))))])])]))
+
+(define (mergesort {x* : (List Int)} → (List Int))
+  (match x* with
+   [Nil -> Nil]
+   [Cons h t ->
+    (match t with
+     [Nil -> (Cons h Nil)]
+     [Cons h2 t2 ->
+      (match (split x*) with
+       [Pair x* y* ->
+        (merge (Pair (mergesort x*) (mergesort y*)))])])]))
+
+(check-type
+  (mergesort (Nil {Int}))
+  : (List Int)
+  ⇒ (Nil {Int}))
+
+(check-type
+  (mergesort (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
+  : (List Int)
+  ⇒ (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
+
+(check-type
+  (mergesort (Cons 3 (Cons 7 (Cons 93 (Cons 0 (Cons 2 Nil))))))
+  : (List Int)
+  ⇒ (Cons 0 (Cons 2 (Cons 3 (Cons 7 (Cons 93 Nil))))))
+
+;; -----------------------------------------------------------------------------
+;; --- quicksort
+
+(define (quicksort [x* : (List Int)] → (List Int))
+  (match x* with
+   [Nil -> x*]
+   [Cons h t ->
+    (match t with
+     [Nil -> x*]
+     [Cons h2 t2 ->
+      (append
+        (quicksort (filter (λ ([y : Int]) (if (<= y h) True False)) t))
+        (append
+          (Cons h Nil)
+          (quicksort (filter (λ ([y : Int]) (if (> y h) True False)) t))))])]))
+
+(check-type
+  (quicksort (Nil {Int}))
+  : (List Int)
+  ⇒ (Nil {Int}))
+
+(check-type
+  (quicksort (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
+  : (List Int)
+  ⇒ (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
+
+(check-type
+  (quicksort (Cons 3 (Cons 7 (Cons 93 (Cons 0 (Cons 2 Nil))))))
+  : (List Int)
+  ⇒ (Cons 0 (Cons 2 (Cons 3 (Cons 7 (Cons 93 Nil))))))
+
+;; =============================================================================
+;; === CPS
+
+;; -----------------------------------------------------------------------------
+;; --- factorial
+
+(define (fact [n : Int] → Int)
+  (if (< n 2)
+    1
+    (* n (fact (- n 1)))))
+
+(define (range-aux [n : Int] → (List Int))
+  (if (= 0 n)
+    (Cons n Nil)
+    (Cons n (range-aux (- n 1)))))
+
+(define (range [n : Int] → (List Int))
+  (if (<= n 0)
+    Nil
+    (reverse (range-aux (- n 1)))))
+
+(define (fact-acc [n : Int] → Int)
+  (foldl (λ ([acc : Int] [n : Int]) (* n acc)) 1 (map (λ ([n : Int]) (+ n 1)) (range n))))
+
+(define (fact-cps-aux [n : Int] [k : (→ Int Int)] → Int)
+  (if (< n 2)
+    (k 1)
+    (fact-cps-aux (- n 1) (λ ([m : Int]) (k (* n m))))))
+
+(define (fact-cps [n : Int] → Int)
+  (fact-cps-aux n (λ ([x : Int]) x)))
+
+(check-type (fact 0) : Int ⇒ 1)
+(check-type (fact 1) : Int ⇒ 1)
+(check-type (fact 2) : Int ⇒ 2)
+(check-type (fact 3) : Int ⇒ 6)
+(check-type (fact 4) : Int ⇒ 24)
+(check-type (fact 5) : Int ⇒ 120)
+
+(check-type (fact-acc 0) : Int ⇒ 1)
+(check-type (fact-acc 1) : Int ⇒ 1)
+(check-type (fact-acc 2) : Int ⇒ 2)
+(check-type (fact-acc 3) : Int ⇒ 6)
+(check-type (fact-acc 4) : Int ⇒ 24)
+(check-type (fact-acc 5) : Int ⇒ 120)
+
+(check-type (fact-cps 0) : Int ⇒ 1)
+(check-type (fact-cps 1) : Int ⇒ 1)
+(check-type (fact-cps 2) : Int ⇒ 2)
+(check-type (fact-cps 3) : Int ⇒ 6)
+(check-type (fact-cps 4) : Int ⇒ 24)
+(check-type (fact-cps 5) : Int ⇒ 120)
+
+;; -----------------------------------------------------------------------------
+;; --- map
+
+(define (map-cps-aux [f : (→ A B)] [x* : (List A)] [k : (→ (List B) (List B))] → (List B))
+  (match x* with
+   [Nil -> (k Nil)]
+   [Cons x x* ->
+    (map-cps-aux f x* (λ ([b* : (List B)]) (k (Cons (f x) b*))))]))
+
+(define (map-cps [f : (→ A B)] [x* : (List A)] → (List B))
+  (map-cps-aux f x* (λ ([x : (List B)]) x)))
+
+(check-type
+  (map-cps (λ ([x : Int]) (+ x 2)) (Cons 2 (Cons 4 (Cons 8 Nil))))
+  : (List Int)
+  ⇒ (Cons 4 (Cons 6 (Cons 10 Nil))))
+
+(check-type
+  (map-cps exact->inexact (Cons 2 (Cons 4 (Cons 8 Nil))))
+  : (List Float)
+  ⇒ (Cons 2.0 (Cons 4.0 (Cons 8.0 Nil))))
+
diff --git a/tapl/tests/mlish/bg/ps1.mlish b/tapl/tests/mlish/bg/ps1.mlish
deleted file mode 100644
index f56680e..0000000
--- a/tapl/tests/mlish/bg/ps1.mlish
+++ /dev/null
@@ -1,248 +0,0 @@
-#lang s-exp "../../../mlish.rkt"
-(require "../../rackunit-typechecking.rkt")
-
-;; =============================================================================
-
-(define-type (List X)
-  Nil
-  (Cons X (List X)))
-
-;; =============================================================================
-;; http://www.cs.cornell.edu/courses/cs3110/2011fa/hw/ps1/ps1.html
-
-(define (fn-list [f* : (List (→ A A))] [a : A] → A)
-  (match f* with
-   [Nil -> a]
-   [Cons f f* -> (fn-list f* (f a))]))
-
-(check-type
-  (fn-list (Cons (λ ([x : Int]) (+ x 1)) (Cons (λ ([x : Int]) (* x 2)) Nil)) 4)
-  : Int
-  ⇒ 10)
-
-;; -----------------------------------------------------------------------------
-
-(define (count-letters/one [s : String] [c : Char] → Int)
-  (for/sum ([i (in-range (string-length s))])
-    (if (equal? (string-ref s i) c)
-      1
-      0)))
-
-(define (count-letters [s* : (List String)] [c : Char] → Int)
-  (match s* with
-   [Nil -> 0]
-   [Cons s s* -> (+ (count-letters/one s c)
-                    (count-letters s* c))]))
-
-(check-type
-  (count-letters (Cons "OCaml" (Cons "Is" (Cons "Alot" (Cons "Better" (Cons "Than" (Cons "Java" Nil)))))) (string-ref "a" 0))
-  : Int
-  ⇒ 4)
-
-;; -----------------------------------------------------------------------------
-
-(define (map [f : (→ A B)] [x* : (List A)] → (List B))
-  (match x* with
-   [Nil -> Nil]
-   [Cons x x* -> (Cons (f x) (map f x*))]))
-
-(define (append [x* : (List A)] [y* : (List A)] → (List A))
-  (match x* with
-   [Nil -> y*]
-   [Cons x x* -> (Cons x (append x* y*))]))
-
-(define (flatten [x** : (List (List A))] → (List A))
-  (match x** with
-   [Nil -> Nil]
-   [Cons x* x** -> (append x* (flatten x**))]))
-
-(define (insert [x : A] → (→ (List A) (List (List A))))
-  (λ ([x* : (List A)])
-    (Cons (Cons x x*)
-      (match x* with
-       [Nil -> Nil]
-       [Cons y y* -> (map (λ ([z* : (List A)]) (Cons y z*))
-                          ((insert x) y*))]))))
-
-(define (permutations [x* : (List A)] → (List (List A)))
-  (match x* with
-   [Nil -> (Cons Nil Nil)]
-   [Cons x x* -> (flatten (map (insert x) (permutations x*)))]))
-
-(check-type
-  (permutations (Nil {Int}))
-  : (List (List Int))
-  ⇒ (Cons (Nil {(List Int)}) Nil))
-
-(check-type
-  (permutations (Cons 1 Nil))
-  : (List (List Int))
-  ⇒ (Cons (Cons 1 Nil) Nil))
-
-(check-type
-  (permutations (Cons 1 (Cons 2 Nil)))
-  : (List (List Int))
-  ⇒ (Cons (Cons 1 (Cons 2 Nil)) (Cons (Cons 2 (Cons 1 Nil)) Nil)))
-
-(check-type
-  (permutations (Cons 1 (Cons 2 (Cons 3 Nil))))
-  : (List (List Int))
-  ⇒ (Cons (Cons 1 (Cons 2 (Cons 3 Nil)))
-    (Cons (Cons 2 (Cons 1 (Cons 3 Nil)))
-    (Cons (Cons 2 (Cons 3 (Cons 1 Nil)))
-    (Cons (Cons 1 (Cons 3 (Cons 2 Nil)))
-    (Cons (Cons 3 (Cons 1 (Cons 2 Nil)))
-    (Cons (Cons 3 (Cons 2 (Cons 1 Nil)))
-    Nil)))))))
-
-;; =============================================================================
-;; http://www.cs.cornell.edu/courses/cs3110/2011sp/hw/ps1/ps1.htm
-
-(define-type (** X Y)
-  (Pair X Y))
-
-(define (split [ab* : (List (** A B))] → (** (List A) (List B)))
-  (match ab* with
-   [Nil -> (Pair Nil Nil)]
-   [Cons ab ab* ->
-    (match ab with
-     [Pair a b ->
-      (match (split ab*) with
-       [Pair a* b* ->
-        (Pair (Cons a a*)
-              (Cons b b*))])])]))
-
-(check-type
-  (split (Nil {(** Int Int)}))
-  : (** (List Int) (List Int))
-  ⇒ (Pair (Nil {Int}) (Nil {Int})))
-
-(check-type
-  (split (Cons (Pair 1 2) (Cons (Pair 3 4) Nil)))
-  : (** (List Int) (List Int))
-  ⇒ (Pair (Cons 1 (Cons 3 Nil))
-          (Cons 2 (Cons 4 Nil))))
-
-(check-type
-  (split (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil))))
-  : (** (List Int) (List String))
-  ⇒ (Pair (Cons 1 (Cons 2 (Cons 3 Nil)))
-          (Cons "one" (Cons "two" (Cons "three" Nil)))))
-
-;; -----------------------------------------------------------------------------
-
-(define (combine [a*b* : (** (List A) (List B))] → (List (** A B)))
-  (match a*b* with
-   [Pair a* b* ->
-    (match a* with
-     [Nil ->
-      (match b* with
-       [Nil ->
-        Nil]
-       [Cons b b* ->
-        Nil])] ;; Error
-     [Cons a a* ->
-      (match b* with
-       [Nil ->
-        Nil] ;; Error
-       [Cons b b* ->
-        (Cons (Pair a b) (combine (Pair a* b*)))])])]))
-
-(check-type
-  (combine (Pair (Nil {Int}) (Nil {Int})))
-  : (List (** Int Int))
-  ⇒ (Nil {(** Int Int)}))
-
-(check-type
-  (combine (Pair (Cons 1 (Cons 2 Nil)) (Cons 3 (Cons 4 Nil))))
-  : (List (** Int Int))
-  ⇒ (Cons (Pair 1 3) (Cons (Pair 2 4) Nil)))
-
-(check-type
-  (combine (split (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil)))))
-  : (List (** Int String))
-  ⇒ (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil))))
-
-;; -----------------------------------------------------------------------------
-
-(define (fst [xy : (** A B)] → A)
-  (match xy with
-   [Pair x y -> x]))
-
-(define (snd [xy : (** A B)] → B)
-  (match xy with
-   [Pair x y -> y]))
-
-(define (foldl [f : (→ A B A)] [acc : A] [x* : (List B)] → A)
-  (match x* with
-   [Nil -> acc]
-   [Cons x x* -> (foldl f (f acc x) x*)]))
-
-(define (sum [x* : (List Float)] → Float)
-  (foldl fl+ (exact->inexact 0) x*))
-
-(define (reverse [x* : (List A)] → (List A))
-  (foldl (λ ([x* : (List A)] [x : A]) (Cons x x*)) Nil x*))
-
-(define (convolve [x* : (List Float)] [y* : (List Float)] → Float)
-  (sum
-    (map (λ ([xy : (** Float Float)]) (fl* (fst xy) (snd xy)))
-      (combine (Pair x* (reverse y*))))))
-
-(check-type
-  (convolve (Cons 1.0 (Cons 2.0 (Cons 3.0 Nil))) (Cons 1.0 (Cons 2.0 (Cons 3.0 Nil))))
-  : Float
-  ⇒ (fl+ (fl+ (fl* 1.0 3.0) (fl* 2.0 2.0)) (fl* 3.0 1.0)))
-
-;; -----------------------------------------------------------------------------
-
-(define (mc [n : Int] [f : (→ A A)] [x : A] → A)
-  (for/fold ([x x])
-            ([_i (in-range n)])
-    (f x)))
-
-(check-type
-  (mc 3000 (λ ([n : Int]) (+ n 1)) 3110)
-  : Int
-  ⇒ 6110)
-
-(define (square [n : Int] → Int)
-  (* n n))
-
-(check-type
-  (mc 0 square 2)
-  : Int
-  ⇒ 2)
-
-(check-type
-  (mc 2 square 2)
-  : Int
-  ⇒ 16)
-
-(check-type
-  (mc 3 square 2)
-  : Int
-  ⇒ 256)
-
-;; -----------------------------------------------------------------------------
-
-(define (successor [mcn : (→ (→ A A) A A)] → (→ (→ A A) A A))
-  (λ ([f : (→ A A)] [x : A])
-    (f (mcn f x))))
-
-(check-type
-  ((successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x))) square 2)
-  : Int
-  ⇒ 4)
-
-(check-type
-  ((successor (successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x)))) square 2)
-  : Int
-  ⇒ 16)
-
-(check-type
-  ((successor (successor (successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x))))) square 2)
-  : Int
-  ⇒ 256)
-
-;; # (mc 3 successor) (mc 0) square 2;;