64 lines
1.6 KiB
Haskell
64 lines
1.6 KiB
Haskell
{-# LANGUAGE OverloadedLists #-}
|
|
module Gyehoek.CPS.Convert
|
|
( convert
|
|
, convertProgram
|
|
) 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
|
|
import Control.Lens
|
|
import qualified Data.List.NonEmpty as NE
|
|
|
|
|
|
-- 뻘짓이어라
|
|
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] <$> k (ValVar r)
|
|
|
|
convert (Scm.ExpLambda xs e) k = do
|
|
f <- gensym' "λ-body"
|
|
ktail <- gensym' "λ-tail"
|
|
m <- convert e $ \e' ->
|
|
pure $ ExpContinue ktail [e']
|
|
ExpLet [(f, MkLambda 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 (Scm.ExpBegin xs) k = _
|
|
|
|
convert (Scm.ExpIf c t f) k =
|
|
convert c \c' ->
|
|
ExpIf c' <$> convert t k <*> convert f k
|
|
|
|
convert _ k = _
|
|
|
|
convertProgram :: forall es. (GenSym :> es) => Scm.Program -> Eff es Program
|
|
convertProgram p =
|
|
MkProgram <$> telescope (convert @es) (p ^.. each . _Left) \exps ->
|
|
pure . Halt1 $ case NE.nonEmpty exps of
|
|
Nothing -> ValLit Void
|
|
Just es -> NE.last es
|