{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TemplateHaskell #-}
module Gyehoek.CPS.Syntax
  ( Val(..)
  , Kappa(..)
  , Lambda(..)
  , Exp(..)
  , Name(..)
  , Prim(..)
  , Program(..)
  , Lit(..)
  , pattern Void
  , pattern Halt
  , pattern Halt1
  , _MkKappa
  , _ExpPrim
  , _ExpFix
  , _ExpApply
  )
  where

import Language.SexpGrammar qualified as S
import Gyehoek.Sexp qualified
import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void)
import Data.Text (Text)
import Data.List (List)
import GHC.Generics (Generic)
import Language.SexpGrammar.Generic
import Control.Category
import Control.Lens
import Data.Text qualified as T
import Data.Generics.Labels
import Prelude hiding ((.), id)
import Data.List.NonEmpty (NonEmpty)
import Data.InvertibleGrammar.Base qualified as IGB
import Data.InvertibleGrammar.Base ((:-)((:-)))
import qualified Data.InvertibleGrammar as IG

-- Data types

data Val
  = ValLabel Name
  | ValVar Name
  | ValLit Lit
  deriving (Show, Generic)

data Kappa = MkKappa (List Name) Exp
  deriving (Show, Generic)

data Lambda = MkLambda (List Name) Name Exp
  deriving (Show, Generic)

data Exp
  = ExpPrim (Prim Val) (List Name) Exp
  | ExpFix (NonEmpty (Name, Kappa)) Exp
  | ExpLet (NonEmpty (Name, Lambda)) Exp
  | ExpContinue Name (List Val)
  | ExpIf Val Exp Exp
  | ExpApply Val (List Val)
  deriving (Show, Generic)

pattern Halt :: List Val -> Exp
pattern Halt xs = ExpApply (ValVar "halt") xs

pattern Halt1 :: Val -> Exp
pattern Halt1 x = ExpApply (ValVar "halt") [x]

data Def = DefConstant Name Exp
  deriving (Show, Generic)

data Program = MkProgram
  { body :: Exp
  }
  deriving (Show, Generic)

makePrisms ''Kappa
makePrisms ''Exp


-- SexpIso instances

instance S.SexpIso Val where
  sexpIso = match
    $ With (. label)
    $ With (. var)
    $ With (. S.sexpIso)
    $ End
    where
      label = S.keyword >>> S.iso MkName getName
      var = S.sexpIso

instance S.SexpIso Lambda where
  sexpIso = match
    $ With (. lambda)
    $ End
    where
      lambda = S.list $
        S.el Gyehoek.Sexp.lambdaKeyword
        >>> S.el (S.list (S.rest S.sexpIso))
        >>> S.el S.sexpIso
        >>> S.el S.sexpIso

instance S.SexpIso Kappa where
  sexpIso = match
    $ With (. kappa)
    $ End
    where
      kappa = S.list $
        S.el Gyehoek.Sexp.kappaKeyword
        >>> S.el (S.list $ S.rest S.sexpIso)
        >>> S.el S.sexpIso

instance S.SexpIso Exp where
  sexpIso = match
    $ With (. prim)
    $ With (. fix)
    $ With (. let_)
    $ With (. continue)
    $ With (. if_)
    $ With (. app)
    $ End
    where
      continue = S.list $
        S.el (S.sym "continue")
        >>> S.el S.sexpIso
        >>> S.rest S.sexpIso
      fix = Gyehoek.Sexp.let_ "fix" S.sexpIso S.sexpIso S.sexpIso
      let_ = Gyehoek.Sexp.let_ "let" S.sexpIso S.sexpIso S.sexpIso
      if_ = S.list $ S.el (S.sym "if")
        >>> S.el S.sexpIso >>> S.el S.sexpIso >>> S.el S.sexpIso
      app = S.list $ S.el S.sexpIso >>> S.rest S.sexpIso
      prim = S.list $
        S.el (S.sym "prim")
        >>> S.el (primSexpIso id (S.sexpIso @Val))
        >>> S.el S.sexpIso
        >>> S.el S.sexpIso

instance S.SexpIso Program where
  sexpIso = with \prog -> S.sexpIso @Exp >>> prog