Created
December 9, 2014 18:03
-
-
Save pchiusano/9047a14b53b49b10a010 to your computer and use it in GitHub Desktop.
Fiddling with a different abstract machine for nonstrict evaluation
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
module Main where | |
import Debug.Trace | |
data Runtime | |
= Prim !Int | |
| Await !Strictness !(Runtime -> Runtime) | |
| App !Runtime !Runtime | |
whnf :: Runtime -> Runtime | |
whnf i@(Prim _) = i | |
whnf a@(Await _ _) = a | |
whnf (App f x) = case whnf f of | |
Await Strict body -> case whnf x of x -> whnf (body x) | |
Await Nonstrict body -> whnf (body x) | |
_ -> error "cannot apply a non-function" | |
instance Show Runtime where | |
show r = case r of | |
Prim n -> show n | |
App f x -> show f ++ " " ++ show x | |
Await _ _ -> "<await>" | |
data Strictness = Strict | Nonstrict | |
nil :: Runtime | |
nil = Await Strict (\z -> Await Nonstrict (\_ -> z)) | |
int :: Int -> Runtime | |
int = Prim | |
cons :: Runtime -> Runtime -> Runtime | |
cons h t = Await Nonstrict (\_ -> Await Strict (\f -> f `App` h `App` t)) | |
-- Skip over an argument | |
skip :: Runtime -> Runtime | |
skip r = Await Nonstrict (\_ -> r) | |
-- foldl :: ![] -> !(s b -> s2 a -> s b) -> s b -> !b | |
-- foldl [] !f z = z | |
-- foldl (h:t) !f z = foldl t f (f z h) | |
-- Gak, this is pretty ugly | |
foldlRuntime :: Runtime | |
foldlRuntime = Await Strict $ \list -> | |
list `App` (Await Strict (\_ -> Await Strict id)) | |
`App` (Await Nonstrict (\h -> Await Nonstrict (\t -> | |
Await Strict (\f@(Await strictness _) -> | |
Await strictness (\z -> ("z: " ++ show z) `trace` | |
foldlRuntime `App` t | |
`App` f | |
`App` (f `App` z `App` h)))))) | |
plus :: Runtime | |
plus = Await Strict (\x -> case x of | |
Prim x -> Await Strict (\y -> case y of | |
Prim y -> Prim (x+y) | |
_ -> error "second argument to `plus` not a Prim") | |
App f x -> error "first argument to `plus` is an `App`" | |
_ -> error "first argument to `plus` not a Prim") | |
nums :: Runtime | |
nums = foldr cons nil (map int [0..1000]) | |
incr :: Runtime | |
incr = plus `App` (Await Strict id) `App` int 1 | |
sumExample :: Runtime -- Int | |
sumExample = foldlRuntime `App` nums `App` plus `App` int 0 | |
add :: Int -> Int -> Int | |
add x y = x + y | |
main = case whnf (incr `App` int 41) of | |
Prim n -> putStrLn (show n) | |
_ -> error "failed" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment