This commit is contained in:
+86
@@ -46,3 +46,89 @@ largely based on the Guile Hoot's [[https://codeberg.org/spritely/hoot/src/branc
|
||||
(push! x)
|
||||
(call! h))
|
||||
#+end_src
|
||||
|
||||
** fac
|
||||
|
||||
*** Scheme source
|
||||
|
||||
#+begin_src scheme
|
||||
(define fac
|
||||
(λ (n)
|
||||
(if (zero? n)
|
||||
1
|
||||
(* n (fac (- n 1))))))
|
||||
|
||||
(fac 3)
|
||||
#+end_src
|
||||
|
||||
*** CPS
|
||||
|
||||
#+begin_src scheme
|
||||
(define fac
|
||||
(λ (n ktail)
|
||||
(zero? n (κ (x0)
|
||||
(if x0
|
||||
1
|
||||
(- n 1
|
||||
(κ (x1)
|
||||
(fac x1
|
||||
(κ (x2)
|
||||
(* n x2 ktail))))))))))
|
||||
|
||||
(fac 3 halt)
|
||||
|
||||
#+end_src
|
||||
|
||||
*** tailified
|
||||
|
||||
#+begin_src scheme
|
||||
(define (fac-k1)
|
||||
(define n (pop!))
|
||||
(define x2 (pop!))
|
||||
(define x3 (* n x2))
|
||||
(define ktail (pop-cont!))
|
||||
(push! x3)
|
||||
(call! ktail))
|
||||
|
||||
(define (fac-k0)
|
||||
(define x0 (pop!))
|
||||
(define n (pop!))
|
||||
(if x0
|
||||
(begin (define ktail (pop-cont!))
|
||||
(push! 1)
|
||||
(call! ktail))
|
||||
(begin (define x1 (- n 1))
|
||||
(push! x1)
|
||||
(push-cont! fac-k1)
|
||||
(call! fac))))
|
||||
|
||||
(define (fac)
|
||||
(define n (pop!))
|
||||
(push! n)
|
||||
(push-cont! fac-k0)
|
||||
(push! n)
|
||||
(call! zero?))
|
||||
|
||||
(push! 3)
|
||||
(push-cont! halt)
|
||||
(call! fac)
|
||||
#+end_src
|
||||
|
||||
evaluation of ~(fac 0)~:
|
||||
|
||||
#+begin_src scheme
|
||||
(push! 0) ; [] []
|
||||
(push-cont! halt) ; [0] []
|
||||
(call! fac) ; [0] [halt]
|
||||
(define n (pop!)) ; [0] [halt]
|
||||
(push! n) ; [] [halt]
|
||||
(push-cont! fac-k0) ; [0] [halt]
|
||||
(push! n) ; [0] [halt fac-k0]
|
||||
(call! zero?) ; [0 0] [halt fac-k0]
|
||||
#<internals of zero?> ; [0 0] [halt fac-k0]
|
||||
(define x0 (pop!)) ; [0 #t] [halt]
|
||||
(define n (pop!)) ; [0] [halt]
|
||||
(define ktail (pop-cont!)) ; [] [halt]
|
||||
(push! 1) ; [] []
|
||||
(call! ktail) ; [1] []
|
||||
#+end_src
|
||||
|
||||
@@ -1,22 +0,0 @@
|
||||
;; -*- mode:scheme -*-
|
||||
|
||||
(define (silly)
|
||||
(define f (pop!))
|
||||
(define g (pop!))
|
||||
(define h (pop!))
|
||||
(define x (pop!))
|
||||
(define ktail (pop-cont!))
|
||||
(push-cont! (κ (x0)
|
||||
(define x* (pop!))
|
||||
(define g* (pop!))
|
||||
(push-cont! (κ (x1)
|
||||
(define f* (pop!))
|
||||
(define x0* (pop!))
|
||||
(push-cont! ktail)
|
||||
(push! x0*)
|
||||
(push! x1)
|
||||
(call! f)))
|
||||
(push! x*)
|
||||
(call! g)))
|
||||
(push! x)
|
||||
(call! h))
|
||||
Reference in New Issue
Block a user