<commit_before>-- |
-- Module      : $Header$
-- Description : The low level dataflow graph the compiler produces in the end
-- Copyright   : (c) <NAME> and <NAME> 2017. All Rights Reserved.
-- License     : EPL-1.0
-- Maintainer  : <EMAIL>, <EMAIL>
-- Stability   : experimental

-- This source code is licensed under the terms described in the associated LICENSE.TXT file
{-# LANGUAGE DeriveGeneric #-}
module Ohua.DFGraph where


import           Data.Aeson
import           Data.Foldable
import qualified Data.HashMap.Strict as HM
import           Data.Maybe
import           GHC.Generics
import           Ohua.ALang.Lang
import           Ohua.DFLang.Lang
import           Ohua.Types



data Operator = Operator
    { operatorId   :: !FnId
    , operatorType :: !QualifiedBinding
    } deriving (Eq, Generic, Show)

data Target = Target
    { operator :: !FnId
    , index    :: !Int
    } deriving (Eq, Generic, Show)


data Arc envExpr = Arc
    { target :: !Target
    , source :: !(Source envExpr)
    } deriving (Eq, Generic, Show)

instance Functor Arc where
    fmap f (Arc target source) = Arc target (fmap f source)


data Source envExpr
    = LocalSource !Target
    | EnvSource !envExpr
    deriving (Eq, Generic, Show)

instance Functor Source where
    fmap f (EnvSource e)   = EnvSource $ f e
    fmap _ (LocalSource t) = LocalSource t


-- | Graph emitted by the compiler. Abstracted over the type of environment expression it contains.
data AbstractOutGraph envExpr = OutGraph
    { operators :: [Operator]
    , arcs      :: [Arc envExpr]
    } deriving (Eq, Generic, Show)


instance Functor AbstractOutGraph where
    fmap f (OutGraph ops arcs) = OutGraph ops (fmap (fmap f) arcs)


type OutGraph = AbstractOutGraph HostExpr


toGraph :: DFExpr -> OutGraph
toGraph (DFExpr lets _) = OutGraph ops arcs
  where
    ops = map toOp $ toList lets
    toOp e = Operator (callSiteId e) (deRef e)

    deRef = (\case DFFunction n -> n; EmbedSf n -> n) . functionRef

    sources =
        HM.fromList
        $ toList lets
            >>= \l ->
                    [ (var, Target (callSiteId l) index)
                    | (var, index) <- case returnAssignment l of
                                        Direct v         -> [(v, -1)]
                                        Destructure vars -> zip vars [0..]
                    ]

    arcs = concatMap toArc (toList lets)

    toArc l =
        [ Arc target $
            case arg of
                DFVar v -> LocalSource $ fromMaybe (error $ "Undefined Binding " ++ show v) (HM.lookup v sources)
                DFEnvVar envExpr -> EnvSource envExpr
        | (arg, index) <- maybe id ((:) . (,-1) . DFVar) (contextArg l)
                          -- prepend (ctxBinding, -1) if there is a context arc
                            $ zip (callArguments l) [0..]
        , let target = Target (callSiteId l) index
        ]<commit_msg>Generalized env splicing, moved it into core<commit_after>-- |
-- Module      : $Header$
-- Description : The low level dataflow graph the compiler produces in the end
-- Copyright   : (c) <NAME> and Justus Adam 2017. All Rights Reserved.
-- License     : EPL-1.0
-- Maintainer  : <EMAIL>, <EMAIL>
-- Stability   : experimental

-- This source code is licensed under the terms described in the associated LICENSE.TXT file
{-# LANGUAGE DeriveGeneric #-}
module Ohua.DFGraph where


import           Data.Aeson
import           Data.Foldable
import qualified Data.HashMap.Strict as HM
import           Data.Maybe
import           GHC.Generics
import           Ohua.ALang.Lang
import           Ohua.DFLang.Lang
import           Ohua.Types



data Operator = Operator
    { operatorId   :: !FnId
    , operatorType :: !QualifiedBinding
    } deriving (Eq, Generic, Show)

data Target = Target
    { operator :: !FnId
    , index    :: !Int
    } deriving (Eq, Generic, Show)


data Arc envExpr = Arc
    { target :: !Target
    , source :: !(Source envExpr)
    } deriving (Eq, Generic, Show)

instance Functor Arc where
    fmap f (Arc target source) = Arc target (fmap f source)


data Source envExpr
    = LocalSource !Target
    | EnvSource !envExpr
    deriving (Eq, Generic, Show)

instance Functor Source where
    fmap f (EnvSource e)   = EnvSource $ f e
    fmap _ (LocalSource t) = LocalSource t


-- | Graph emitted by the compiler. Abstracted over the type of environment expression it contains.
data AbstractOutGraph envExpr = OutGraph
    { operators :: [Operator]
    , arcs      :: [Arc envExpr]
    } deriving (Eq, Generic, Show)


instance Functor AbstractOutGraph where
    fmap f (OutGraph ops arcs) = OutGraph ops (fmap (fmap f) arcs)


type OutGraph = AbstractOutGraph HostExpr


toGraph :: DFExpr -> OutGraph
toGraph (DFExpr lets _) = OutGraph ops arcs
  where
    ops = map toOp $ toList lets
    toOp e = Operator (callSiteId e) (deRef e)

    deRef = (\case DFFunction n -> n; EmbedSf n -> n) . functionRef

    sources =
        HM.fromList
        $ toList lets
            >>= \l ->
                    [ (var, Target (callSiteId l) index)
                    | (var, index) <- case returnAssignment l of
                                        Direct v         -> [(v, -1)]
                                        Destructure vars -> zip vars [0..]
                    ]

    arcs = concatMap toArc (toList lets)

    toArc l =
        [ Arc target $
            case arg of
                DFVar v -> LocalSource $ fromMaybe (error $ "Undefined Binding " ++ show v) (HM.lookup v sources)
                DFEnvVar envExpr -> EnvSource envExpr
        | (arg, index) <- maybe id ((:) . (,-1) . DFVar) (contextArg l)
                          -- prepend (ctxBinding, -1) if there is a context arc
                            $ zip (callArguments l) [0..]
        , let target = Target (callSiteId l) index
        ]


spliceEnv :: OutGraph -> (Int -> a) -> AbstractOutGraph a
spliceEnv (OutGraph ops oldArcs) lookup = OutGraph ops arcs
  where
    arcs = map f oldArcs
    f (Arc t source) = Arc t $ case source of
        EnvSource (HostExpr i) -> EnvSource (lookup i)
        LocalSource t -> LocalSource t
{'fraction_non_alphanumeric': 0.09307253463732681, 'fraction_numerical': 0.0035859820700896495, 'mean_word_length': 1.9743092583616093, 'pattern_counts': {'":': 0, '<': 14, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1958530', 'n_tokens_mistral': 1829, 'n_tokens_neox': 1733, 'n_words': 649}