<commit_before>{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-|
Given a Technique Procedure (concrete syntax tree), translate it into an
internalized representation (abstract syntax tree) that can be subsequently
executed (that is, interpreted; evaluated).
-}
module Technique.Translate where

import Control.Monad (when, foldM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Except (MonadError(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.State.Strict (StateT(..), evalStateT, execStateT, runStateT)
import Control.Monad.Trans.Except (Except(..), runExcept)
import Core.Data
import Core.Text
import Data.Foldable (foldl', traverse_)
import Data.UUID.Types (UUID)

import Technique.Builtins
import Technique.Internal
import Technique.Language
import Technique.Quantity


{-|
Environment in the type-theory sense of the word: the map(s) between names
and their bindings.
-}
data Environment = Environment
    { environmentVariables :: Map Identifier Name
    , environmentFunctions :: Map Identifier Procedure
    , environmentRole :: Attribute
    , environmentAccumulated :: Sequence
    }

newtype Translate a = Translate (StateT Environment (Except CompilerFailure) a)
    deriving (Functor, Applicative, Monad, MonadState Environment, MonadError CompilerFailure)

unTranslate :: Translate a -> StateT Environment (Except CompilerFailure) a
unTranslate (Translate r) = r
{-# INLINE unTranslate #-}

{-|
Take a static Procedure definition and spin it up into a "Subroutine"
suitable for interpretation. In other words, translate between the concrete
syntax types and the abstract syntax we can feed to an evaluator.
-}
translate :: Environment -> Procedure -> Either CompilerFailure Subroutine
translate env procedure =
  let
    block = procedureBlock procedure
    result = runTranslate env (translateBlock block)
  in
    case result of
        Left e -> Left e
        Right env' -> Right $
            Subroutine
                { subroutineSource = procedure
                , subroutineSteps = environmentAccumulated env'
                }

runTranslate :: Environment -> Translate a -> Either CompilerFailure a
runTranslate env action = runExcept (evalStateT (unTranslate action) env)

{-|
Blocks are scoping mechanisms, so accumulated environment is discarded once
we finish resolving names within it.<commit_msg>Function to run Translate monad<commit_after>{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-|
Given a Technique Procedure (concrete syntax tree), translate it into an
internalized representation (abstract syntax tree) that can be subsequently
executed (that is, interpreted; evaluated).
-}
module Technique.Translate where

import Control.Monad (when, foldM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Except (MonadError(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.State.Strict (StateT(..), evalStateT, execStateT, runStateT)
import Control.Monad.Trans.Except (Except(..), runExcept)
import Core.Data
import Core.Text
import Data.DList (fromList, empty)
import Data.Foldable (foldl', traverse_)
import Data.UUID.Types (UUID)

import Technique.Builtins
import Technique.Internal
import Technique.Language
import Technique.Quantity


{-|
Environment in the type-theory sense of the word: the map(s) between names
and their bindings.
-}
-- TODO perhaps the role should be Maybe Attribute? This will likely need
-- work as there are three states: 1) as yet unspecified, 2) specified, and
-- 3) explicitly reset to any. Are (1) and (3) the same?
data Environment = Environment
    { environmentVariables :: Map Identifier Name
    , environmentFunctions :: Map Identifier Subroutine
    , environmentRole :: Attribute
    , environmentAccumulated :: Step
    }

emptyEnvironment :: Environment
emptyEnvironment = Environment
    { environmentVariables = emptyMap
    , environmentFunctions = emptyMap
    , environmentRole = Unspecified
    , environmentAccumulated = Sequence (empty)
    }

newtype Translate a = Translate (StateT Environment (Except CompilerFailure) a)
    deriving (Functor, Applicative, Monad, MonadState Environment, MonadError CompilerFailure)

runTranslate :: Environment -> Translate a -> Either CompilerFailure a
runTranslate env (Translate action) = runExcept (evalStateT action env)
{-# INLINE runTranslate #-}

{-|
Take a static Procedure definition and spin it up into a "Subroutine"
suitable for interpretation. In other words, translate between the concrete
syntax types and the abstract syntax we can feed to an evaluator.
-}
translate :: Environment -> Procedure -> Either CompilerFailure Subroutine
translate env procedure = runTranslate env (translateProcedure procedure)

translateProcedure :: Procedure -> Translate Subroutine
translateProcedure procedure =
  let
    block = procedureBlock procedure
  in do
    env <- get
    step <- translateBlock block
    return
        (Subroutine
            { subroutineSource = procedure
            , subroutineSteps = step
            }
        )

{-|
Blocks are scoping mechanisms, so accumulated environment is discarded once
we finish resolving names within it.
{'fraction_non_alphanumeric': 0.08042024832855778, 'fraction_numerical': 0.0009551098376313276, 'mean_word_length': 4.230769230769231, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 15, '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': '4302135', 'n_tokens_mistral': 1442, 'n_tokens_neox': 1387, 'n_words': 519}