<commit_before>-- | Imperative code generation for K3.
-- This module provides functions which perform the first stage tree transformation to the
-- imperative embedding. Stringification to a target language must be done subsequently.
module Language.K3.Codegen.Imperative (
    -- * Transformation Types
    ImperativeE,
    ImperativeS,
    ImperativeM,

    -- * Transformation Actions
    runImperativeM,

    -- * Tree Forms
    declaration,
    expression
) where

import Control.Monad.State
import Control.Monad.Trans.Either

import Data.Maybe
import Data.Functor
import Data.Tree

import Language.K3.Core.Annotation

import Language.K3.Core.Common
import Language.K3.Core.Declaration
import Language.K3.Core.Expression
import Language.K3.Core.Type

import qualified Language.K3.Core.Constructor.Type as T

import Language.K3.Codegen.Common

type ImperativeE = ()
type ImperativeS = ()

type ImperativeM a = EitherT ImperativeE (State ImperativeS) a

runImperativeM :: ImperativeM a -> ImperativeS -> (Either ImperativeE a, ImperativeS)
runImperativeM m s = flip runState s $ runEitherT m

declaration :: K3 Declaration -> ImperativeM (K3 Declaration)
declaration (Node (DGlobal i t (Just e) :@: as) cs) = do
    me' <- expression e
    cs' <- mapM declaration cs
    return $ Node (DGlobal i t (Just me') :@: as) cs'
declaration (Node (DTrigger i t e :@: as) cs) = do
    ne' <- expression e
    cs' <- mapM declaration cs
    return $ Node (DGlobal i (T.function t T.unit) (Just ne') :@: as) cs'
declaration (Node t cs) = Node t <$> mapM declaration cs

expression :: K3 Expression -> ImperativeM (K3 Expression)
expression (Node t cs) = Node t <$> mapM expression cs<commit_msg>Add expression/variable mutability modifier caching.<commit_after>{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}

-- | Imperative code generation for K3.
-- This module provides functions which perform the first stage tree transformation to the
-- imperative embedding. Stringification to a target language must be done subsequently.
module Language.K3.Codegen.Imperative (
    -- * Transformation Types
    ImperativeE,
    ImperativeS(..),
    ImperativeM,

    -- * Transformation Actions
    runImperativeM,
    defaultImperativeS,

    -- * Tree Forms
    declaration,
    expression
) where

import Control.Arrow ((&&&))
import Control.Monad.State
import Control.Monad.Trans.Either

import Data.Maybe
import Data.Functor
import Data.Tree

import Language.K3.Core.Annotation

import Language.K3.Core.Common
import Language.K3.Core.Declaration
import Language.K3.Core.Expression

import qualified Language.K3.Core.Constructor.Type as T

type ImperativeE = ()

data ImperativeS = ImperativeS {
        mutables :: [Identifier]
    }

type ImperativeM a = EitherT ImperativeE (State ImperativeS) a

runImperativeM :: ImperativeM a -> ImperativeS -> (Either ImperativeE a, ImperativeS)
runImperativeM m s = flip runState s $ runEitherT m

defaultImperativeS :: ImperativeS
defaultImperativeS = ImperativeS { mutables = [] }

withMutable :: Identifier -> ImperativeM a -> ImperativeM a
withMutable i m = do
    oldS <- get
    put $ oldS { mutables = (i:mutables oldS) }
    result <- m
    newS <- get
    case mutables newS of
        (_:xs) -> put (newS { mutables = xs })
        [] -> left ()
    return result

isCachedMutable :: Identifier -> ImperativeM Bool
isCachedMutable i = elem i . mutables <$> get

declaration :: K3 Declaration -> ImperativeM (K3 Declaration)
declaration (Node (DGlobal i t (Just e) :@: as) cs) = do
    me' <- expression e
    cs' <- mapM declaration cs
    return $ Node (DGlobal i t (Just me') :@: as) cs'
declaration (Node (DTrigger i t e :@: as) cs) = do
    ne' <- expression e
    cs' <- mapM declaration cs
    return $ Node (DGlobal i (T.function t T.unit) (Just ne') :@: as) cs'
declaration (Node t cs) = Node t <$> mapM declaration cs

expression :: K3 Expression -> ImperativeM (K3 Expression)
expression e@(tag &&& children -> (ELetIn _, [v@(tag -> EVariable i), _])) = do
    let isMutable = isJust $ v @~ (\case {EMutable -> True; _ -> False})
    let modifier = if isMutable then withMutable i else id
    let (Node t cs) = e in modifier $ Node t <$> mapM expression cs

expression e@(tag -> EVariable i) = do
    b <- isCachedMutable i
    return $ if b then e @+ EMutable else e

expression (Node t cs) = Node t <$> mapM expression cs
{'fraction_non_alphanumeric': 0.10287408759124088, 'fraction_numerical': 0.005474452554744526, 'mean_word_length': 3.483640081799591, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 27, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '959271', 'n_tokens_mistral': 1392, 'n_tokens_neox': 1382, 'n_words': 476}