Last active
February 27, 2024 06:40
-
-
Save Porges/dda3b1a5de3f8c8988962f891597cce5 to your computer and use it in GitHub Desktop.
Trampolining following http://days2012.scala-lang.org/sites/days2012/files/bjarnason_trampolines.pdf
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
open System | |
open System.Diagnostics | |
type InteractionF<'f> = | |
| Get of (string -> 'f) | |
| Put of string * 'f | |
with | |
static member map f = function | |
| Get g -> Get (f << g) | |
| Put (s, g) -> Put (s, f g) | |
module Trampoline = | |
type Trampoline<'a> = | |
private | |
| Step of Step<'a> | |
| Bind of IBind<'a> | |
// existential, should not be used to wrap Bound directly | |
// - the .bind function must be used to re-associate | |
with | |
member this.resume () : Step<'a> = | |
match this with | |
| Step s -> s | |
| Bind b -> b.Bound() | |
member this.bind (f : 'a -> Trampoline<'b>) = | |
// rewrite binds to be right-associative | |
match this with | |
| Bind b -> b.Rebind(f) | |
| Step s -> Bind(Bound(s, f)) | |
and Intermediate<'a> = InteractionF<Trampoline<'a>> | |
and Step<'a> = Yield of 'a | Suspend of (unit -> Intermediate<'a>) | |
and IBind<'a> = | |
abstract member Bound : unit -> Step<'a> | |
abstract member Rebind<'r> : ('a -> Trampoline<'r>) -> Trampoline<'r> | |
and Bound<'a, 'b> (a : Step<'a>, f : ('a -> Trampoline<'b>)) = | |
interface IBind<'b> with | |
member this.Bound () = | |
match a with | |
| Yield v -> f(v).resume() | |
| Suspend k -> Suspend (fun () -> Intermediate<'b>.map (fun (x : Trampoline<'a>) -> x.bind(f)) (k())) | |
member this.Rebind (f') = Bind(Bound(a, fun x -> f(x).bind(f'))) | |
// This isn't strictly necessary but here as an optimization, | |
// (it's a specialized version of Bound). | |
and Delay<'a> (f : unit -> Trampoline<'a>) = | |
interface IBind<'a> with | |
member this.Bound () = f().resume() | |
member this.Rebind(f') = Bind(Delay(fun () -> f().bind(f'))) | |
let rec run (x : Trampoline<'a>) (interpreter : Intermediate<'a> -> Trampoline<'a>) = | |
let rec go (x : Trampoline<'a>) = | |
match x.resume() with | |
| Yield a -> a | |
| Suspend k -> go (interpreter (k())) | |
go x | |
let result x = Step (Yield x) | |
let delay f = Bind(Delay(f)) | |
let define (k : InteractionF<'a>) : Trampoline<'a> = Step (Suspend (fun () -> Intermediate<_>.map (Step << Yield) k)) | |
open Trampoline | |
type TrampolineBuilder() = | |
member this.Return x = result x | |
member this.ReturnFrom x = x | |
// without Delay type, you can use 'Bind(Bound(Done (), f)))' | |
member this.Delay f = delay f | |
member this.Bind(x : Trampoline<_>, f) = x.bind(f) | |
let trampoline = TrampolineBuilder() | |
let get : Trampoline<string> = define (Get id) | |
let put (s : string) : Trampoline<unit> = define (Put(s, ())) | |
let rec ex = trampoline { | |
do! put "Hi, everybody! What's your name?" | |
let! name = get | |
do! put ("Hello, " + name) | |
return name | |
} | |
let rec inc a = trampoline { | |
if a = 1 then return 1 | |
else | |
let! x = inc (a - 1) | |
return x + 1 | |
} | |
let interpret (f : Intermediate<'a>) : Trampoline<'a> = | |
match f with | |
| Get cont -> Console.ReadLine() |> cont | |
| Put (str, cont) -> Console.WriteLine(str); cont | |
[<EntryPoint>] | |
let main _ = | |
let sw = Stopwatch.StartNew() | |
printfn "%A" (run (inc 10000) interpret) | |
printfn "%A" sw.Elapsed | |
0 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment