CPS version of function reversing slice..

..compared with Haskell version.

diff --git a/revCps/rev.go b/revCps/rev.go
new file mode 100644 (file)
index 0000000..5818c45
--- /dev/null
+++ b/revCps/rev.go
@@ -0,0 +1,67 @@
+
+package main
+
+import "fmt"
+
+// Haskell: data R a = R (R a) | E {unE :: a}
+type R func() (R, []int)
+
+// Haskell: Cont (R [a]) [a]
+type Cont func([]int) (R, []int)
+
+func step(x int, xs []int, k Cont) (R, []int) {
+    fmt.Printf("Got x = %v, xs = %v, k = %v\n", x, xs, k)
+    xs = append(xs, x)
+    if k != nil {   // Preserve nil.
+        // Haskell: R (k (x : xs))
+        t := func() (R, []int) { // t is thunk.
+            return k(xs)
+        }
+        return t, nil
+    }
+    return nil, xs
+}
+
+// Haskell: In fact, this is '>>= \zs -> shift (f zs)' in foldr, which is
+// hidden behind 'm'. For reference, haskell shift implementation:
+// shift :: ((a -> r) -> Cont r r) -> Cont r a
+// shift f = Cont $ \k -> runCont (f k) id
+func shift(f func([]int, Cont) (R, []int), k Cont) Cont {
+    return func (xs []int) (R, []int) {
+        return f(xs, k)   // Haskell's shift: runCont (f k) id
+    }
+}
+
+func reverseCps(xs0 []int) (R, []int) {
+    var m Cont  // Haskell: Cont (R [a]) [a]
+    for _, x := range xs0 { // Haskell: foldr .. xs
+        /*
+        m = func (k Cont) Cont {    // Haskell: shift .. >>= m
+            return func (xs []int) (R, []int) {
+                return step(x, xs, k)   // Haskell: runCont (f k) id
+            }
+        }(m) // Capture current m
+        */
+        stepX := func (xs []int, k Cont) (R, []int) { return step(x, xs, k) } // Haskell: step x
+        m = shift(stepX, m) // Haskell: \zs -> m =<< (shift (step x zs))
+    }
+
+    if m != nil {
+        // Unwrap Cont.
+        return m(nil)   // flip runCont id
+    }
+    return nil, []int{} // return . E
+}
+
+func getResult(f R, zs []int) []int {
+    for ; zs == nil; f, zs = f() {    // Haskell: fix run
+        fmt.Printf("Iterate..\n")
+    }
+    return zs
+}
+
+func main() {
+    xs := []int{1, 2, 3, 4}
+    fmt.Printf("%v\n", getResult(reverseCps(xs)))
+}
+

diff --git a/revCps/rev.hs b/revCps/rev.hs
new file mode 100644 (file)
index 0000000..95669c2
--- /dev/null
+++ b/revCps/rev.hs
@@ -0,0 +1,31 @@
+
+import Control.Monad.Trans.Cont
+import Data.Function
+
+data R a = R (R a) | E a
+
+-- This function is called from 'shift' and 'shift' returns immediately
+-- (without calling further continuation) because result is already here - 'R'
+-- value. Continuation 'k' will be called later, when evaluation of returned
+-- 'R' value is forced in 'run'.
+step :: a -> [a] -> ([a] -> R [a]) -> Cont (R [a]) (R [a])
+step x xs k = return $ R (k (x : xs))
+
+reverseCps :: [a] -> R [a]
+reverseCps xs = flip runCont id -- Go: m(nil)
+                -- $ foldr (\x m zs -> shift (step x zs) >>= m)
+                $ foldr -- Go: for _, x := range xs
+                        (\x m -> \zs -> m =<< (shift (step x zs)))    -- Go: m = func (k Cont) Cont {..}
+                        (return . E)    -- Go: return nil, []int
+                        xs
+                        []  -- Initial value of reversed list, Go: Either 'nil' in 'return m(nil)' or '[]int{}' in following 'return nil, []int{}'.
+
+-- 'rec' is anonymous recursion supplied by 'fix'.
+run :: (R [a] -> [a]) -> R [a] -> [a]
+run rec (R z) = rec z
+run rec (E z) = z
+
+main :: IO ()
+main = print
+    . fix run   -- Go: for ; zs == nil; f, zs = f()
+    $ reverseCps [1..5]