51 lines
1.2 KiB
Haskell
51 lines
1.2 KiB
Haskell
{-# LANGUAGE OverloadedLists #-}
|
|
module Gyehoek.CPS.Convert
|
|
( convert
|
|
) where
|
|
|
|
import Gyehoek.CPS.Syntax
|
|
import Gyehoek.Scheme.Syntax qualified as Scm
|
|
import Gyehoek.GenSym
|
|
import Data.List.NonEmpty (NonEmpty((:|)))
|
|
import Effectful
|
|
import Control.Monad.Cont qualified as Cont
|
|
|
|
|
|
-- 뻘짓이어라
|
|
telescope
|
|
:: Traversable t
|
|
=> (a -> (b -> r) -> r)
|
|
-> t a -> (t b -> r) -> r
|
|
telescope f = Cont.runCont . traverse (Cont.cont . f)
|
|
|
|
convert
|
|
:: forall es. (GenSym :> es)
|
|
=> Scm.Exp -> (Val -> Eff es Exp) -> Eff es Exp
|
|
|
|
convert (Scm.ExpVar x) k = k $ ValVar x
|
|
convert (Scm.ExpLit l) k = k $ ValLit l
|
|
|
|
convert (Scm.ExpPrim p) k =
|
|
telescope (convert @es) p \p' -> do
|
|
r <- gensym' "r"
|
|
ExpPrim p' [r] . pure <$> k (ValVar r)
|
|
|
|
convert (Scm.ExpLambda xs e) k = do
|
|
f <- gensym' "f"
|
|
ktail <- gensym' "ktail"
|
|
m <- convert e $ \e' ->
|
|
pure $ ExpApply (ValVar ktail) [e']
|
|
ExpFix [(f, MkKappa (xs ++ [ktail]) m)] <$> k (ValVar f)
|
|
|
|
convert (Scm.ExpApply f xs) k =
|
|
telescope (convert @es) (f:|xs) \(f':|xs') -> do
|
|
r <- gensym' "r"
|
|
x <- gensym' "x"
|
|
m <- k (ValVar x)
|
|
pure $ ExpFix [(r, MkKappa [x] m)] $ ExpApply f' (xs' ++ [ValVar r])
|
|
|
|
convert _ k = _
|
|
|
|
halt :: Applicative f => Val -> f Exp
|
|
halt = pure . ExpApply (ValVar "halt") . pure
|