Last active
February 8, 2024 15:29
-
-
Save ymdryo/6566f8353b96cfaeb2c8310f2b37ea34 to your computer and use it in GitHub Desktop.
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
-- This Source Code Form is subject to the terms of the Mozilla Public | |
-- License, v. 2.0. If a copy of the MPL was not distributed with this | |
-- file, You can obtain one at https://mozilla.org/MPL/2.0/. | |
main :: IO () | |
main = do | |
putStrLn "[elaborateLocalThenShift]" | |
elaborateLocalThenShift | |
putStrLn "" | |
putStrLn "[elaborateShiftThenLocal]" | |
elaborateShiftThenLocal | |
{- | |
===== result ===== | |
[elaborateLocalThenShift] | |
[local scope outer] env = 1.0 | |
[local scope inner] env = 2.0 | |
[local scope outer] env = 1.0 | |
[local scope inner] env = 2.0 | |
[local scope outer] env = 1.0 | |
[local scope inner] env = 2.0 | |
[local scope outer] env = 1.0 | |
[local scope inner] env = 2.0 | |
[local scope outer] env = 1.0 | |
[local scope inner] env = 2.0 | |
[local scope outer] env = 1.0 | |
[elaborateShiftThenLocal] | |
[local scope outer] env = 1.0 | |
[local scope inner] env = 2.0 | |
[local scope outer] env = 2.0 | |
[local scope inner] env = 4.0 | |
[local scope outer] env = 4.0 | |
[local scope inner] env = 8.0 | |
[local scope outer] env = 8.0 | |
[local scope inner] env = 16.0 | |
[local scope outer] env = 16.0 | |
[local scope inner] env = 32.0 | |
[local scope outer] env = 32.0 | |
-} | |
elaborateLocalThenShift :: IO () | |
elaborateLocalThenShift = | |
prog | |
& interpretH elaborateLocal | |
& interpretAsk 1.0 | |
& runEff | |
& runShift | |
& evalState 0 | |
& runEff | |
where | |
prog :: (Local Double !! Ask Double + Shift () !! State Int + IO) () | |
prog = do | |
k <- send1 getCC | |
env <- ask @Double | |
send1 $ sendIns $ putStrLn $ "[local scope outer] env = " ++ show env | |
local @Double (* 2) do | |
whenM (send1 (get @Int) <&> (< 5)) do | |
send1 $ modify @Int (+ 1) | |
env' <- ask @Double | |
send1 $ sendIns $ putStrLn $ "[local scope inner] env = " ++ show env' | |
send1 k | |
elaborateShiftThenLocal :: IO () | |
elaborateShiftThenLocal = do | |
prog | |
& runShift_ | |
& interpretH elaborateLocal | |
& interpretAsk 1.0 | |
& evalState 0 | |
& runEff | |
where | |
prog :: (Shift_ :+: Local Double !! Ask Double + State Int + IO) () | |
prog = do | |
k <- getCC_ | |
env <- ask @Double | |
sendIns $ putStrLn $ "[local scope outer] env = " ++ show env | |
local @Double (* 2) do | |
whenM (get @Int <&> (< 5)) do | |
modify @Int (+ 1) | |
env' <- ask @Double | |
sendIns $ putStrLn $ "[local scope inner] env = " ++ show env' | |
k |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
一応local-then-shiftの方の挙動の説明を軽く付けておくと、
(Local Double !! Ask Double + Shift () !! State Int + IO
なHefty構造の下でsend1 getCC
により継続を取得すると、「localのelaborationの影響を受ける前の命令書としての継続」を取得することができ、これを呼び出すとlocal内でも改変の影響を受けずに振る舞う、みたいな感じですshift-then-localは普通にAEの意味論の通り