{-# LANGUAGE OverloadedLists #-}
{- HLINT ignore "Use camelCase" -}
module Gyehoek.CPS.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
import qualified Gyehoek.Sexp


-- 뻘짓이어라
telescope
  :: Traversable t
  => (a -> (b -> r) -> r)
  -> t a -> (t b -> r) -> r
telescope f = Cont.runCont . traverse (Cont.cont . f)



pattern Atomic e <-
  e@( Scm.ExpLambda _ _
  ; Scm.ExpVar _
  ; Scm.ExpLit _ )

-- | Transform an expression with a meta-continuation.
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' . MkKappa [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']
  ke <- k $ ValVar f
  pure [cps|
    (letrec ((#{f} (λ (##{xs} #{ktail}) #{m})))
      #{ke})
  |]

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 $ ExpLetRec [(r, AbsKappa' [x] m)] $ ExpApply f' xs' 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