From c547fee744066dec19b6f6f552d11d998974bf88 Mon Sep 17 00:00:00 2001 From: sgf Date: Thu, 22 Aug 2024 00:38:15 +0300 Subject: [PATCH] CPS version of function reversing slice.. ..compared with Haskell version. --- revCps/rev.go | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++ revCps/rev.hs | 31 ++++++++++++++++++++++++ 2 files changed, 98 insertions(+) create mode 100644 revCps/rev.go create mode 100644 revCps/rev.hs diff --git a/revCps/rev.go b/revCps/rev.go new file mode 100644 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 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] -- 2.20.1