<commit_before>module L0.TupleArrayTransform
  ( transformProg
  , transformType )
  where

import Control.Applicative
import Control.Monad.State
import Control.Monad.Reader

import qualified Data.Array as A
import Data.Data
import Data.Generics
import Data.List
import Data.Loc
import qualified Data.Map as M

import L0.AbSyn
import L0.FreshNames

transformProg :: Prog Type -> Prog Type
transformProg = map transformFun

data TransformState = TransformState {
    envNameSrc :: NameSource
  }

data TransformEnv = TransformEnv {
    envVarSubst :: M.Map String [Ident Type]
  }

type TransformM = ReaderT TransformEnv (State TransformState)

runTransformM :: TransformM a -> a
runTransformM m = evalState (runReaderT m newEnv) newState
  where newEnv = TransformEnv M.empty
        newState = TransformState $ newNameSource []

new :: String -> TransformM String
new k = do (name, src) <- gets $ newName k . envNameSrc
           modify $ \s -> s { envNameSrc = src }
           return name

substituting :: M.Map String [Ident Type] -> TransformM a -> TransformM a
substituting substs =
  local (\s -> s { envVarSubst = substs `M.union` envVarSubst s })

transformType :: Type -> Type
transformType (Array (Tuple elemts _) size loc) =
  Tuple (map (transformType . arraytype) elemts) loc
  where arraytype t = Array t size loc
transformType (Array elemt size loc) =
  case elemt' of
    Tuple elemts _ -> Tuple (map (transformType . arraytype) elemts) loc
    _ -> Array elemt' size loc
  where elemt' = transformType elemt
        arraytype t = transformType $ Array t size loc
transformType (Tuple elemts loc) = Tuple (map transformType elemts) loc
transformType t = t -- All other types are fine.

transformValue :: Value -> Value
transformValue (ArrayVal arr et loc) =
  case transformType et of
    Tuple ets _
      | [] <- A.elems arr -> TupVal [ arrayVal [] et' loc | et' <- ets ] loc
      | otherwise         ->  TupVal (zipWith asarray ets $ transpose arrayvalues) loc
    et'         -> ArrayVal arr et' loc
  where asarray t vs = transformValue $ arrayVal vs t loc
        arrayvalues = map (tupleValues . transformValue) $ A.elems arr
        tupleValues (TupVal vs _) = vs
        tupleValues _ = error "L0.TupleArrayTransform.transformValue: Element of tuple array is not tuple."
        -- Above should never happen in well-typed program.
transformValue (TupVal vs loc) = TupVal (map transformValue vs) loc
transformValue v = v

transformPat :: TupIdent Type -> TupIdent Type
transformPat (TupId pats loc) = TupId (map transformPat pats) loc
transformPat (Id k) = Id $ transformIdent k

transformIdent :: Ident Type -> Ident Type
transformIdent (Ident name t loc) = Ident name (transformType t) loc

transformFun :: FunDec Type -> FunDec Type
transformFun (fname,rettype,params,body,loc) = (fname, rettype', params', body', loc)
  where rettype' = transformType rettype
        params' = map transformIdent params
        body' = runTransformM $ transformExp body

transformExp :: Exp Type -> TransformM (Exp Type)
transformExp (Literal val) =
  return $ Literal $ transformValue val
transformExp (Var k) = do
  substs <- asks $ M.lookup (identName k) . envVarSubst
  case substs of
    Nothing     -> return $ Var $ transformIdent k
    Just subst' -> return $ TupLit (map Var subst') (srclocOf k)
transformExp (TupLit es loc) = do
  es' <- mapM transformExp es
  return $ TupLit es' loc
transformExp (ArrayLit [] intype loc) =
  return $ case transformType intype of
             Tuple ets _ ->
               TupLit [ ArrayLit [] et loc | et <- ets ] loc
             et' -> ArrayLit [] et' loc
transformExp (ArrayLit es intype loc) = do
  es' <- mapM transformExp es
  case transformType intype of
    Tuple ets _ -> do
      (e, bindings) <- foldM comb (id, replicate (length ets) []) es'
      e <$> tuparrexp (map reverse bindings) ets
        where comb (acce, bindings) e = do
                names <- map fst <$> mapM (newVar "array_tup") ets<commit_msg>Remove obsolete substitution stuff from tuple-array transformer.<commit_after>module L0.TupleArrayTransform
  ( transformProg
  , transformType )
  where

import Control.Applicative
import Control.Monad.State

import qualified Data.Array as A
import Data.Data
import Data.Generics
import Data.List
import Data.Loc

import L0.AbSyn
import L0.FreshNames

transformProg :: Prog Type -> Prog Type
transformProg = map transformFun

data TransformState = TransformState {
    envNameSrc :: NameSource
  }

type TransformM = State TransformState

runTransformM :: TransformM a -> a
runTransformM m = evalState m newState
  where newState = TransformState $ newNameSource []

new :: String -> TransformM String
new k = do (name, src) <- gets $ newName k . envNameSrc
           modify $ \s -> s { envNameSrc = src }
           return name

transformType :: Type -> Type
transformType (Array (Tuple elemts _) size loc) =
  Tuple (map (transformType . arraytype) elemts) loc
  where arraytype t = Array t size loc
transformType (Array elemt size loc) =
  case elemt' of
    Tuple elemts _ -> Tuple (map (transformType . arraytype) elemts) loc
    _ -> Array elemt' size loc
  where elemt' = transformType elemt
        arraytype t = transformType $ Array t size loc
transformType (Tuple elemts loc) = Tuple (map transformType elemts) loc
transformType t = t -- All other types are fine.

transformValue :: Value -> Value
transformValue (ArrayVal arr et loc) =
  case transformType et of
    Tuple ets _
      | [] <- A.elems arr -> TupVal [ arrayVal [] et' loc | et' <- ets ] loc
      | otherwise         ->  TupVal (zipWith asarray ets $ transpose arrayvalues) loc
    et'         -> ArrayVal arr et' loc
  where asarray t vs = transformValue $ arrayVal vs t loc
        arrayvalues = map (tupleValues . transformValue) $ A.elems arr
        tupleValues (TupVal vs _) = vs
        tupleValues _ = error "L0.TupleArrayTransform.transformValue: Element of tuple array is not tuple."
        -- Above should never happen in well-typed program.
transformValue (TupVal vs loc) = TupVal (map transformValue vs) loc
transformValue v = v

transformPat :: TupIdent Type -> TupIdent Type
transformPat (TupId pats loc) = TupId (map transformPat pats) loc
transformPat (Id k) = Id $ transformIdent k

transformIdent :: Ident Type -> Ident Type
transformIdent (Ident name t loc) = Ident name (transformType t) loc

transformFun :: FunDec Type -> FunDec Type
transformFun (fname,rettype,params,body,loc) = (fname, rettype', params', body', loc)
  where rettype' = transformType rettype
        params' = map transformIdent params
        body' = runTransformM $ transformExp body

transformExp :: Exp Type -> TransformM (Exp Type)
transformExp (Literal val) =
  return $ Literal $ transformValue val
transformExp (Var k) = do
  return $ Var $ transformIdent k
transformExp (TupLit es loc) = do
  es' <- mapM transformExp es
  return $ TupLit es' loc
transformExp (ArrayLit [] intype loc) =
  return $ case transformType intype of
             Tuple ets _ ->
               TupLit [ ArrayLit [] et loc | et <- ets ] loc
             et' -> ArrayLit [] et' loc
transformExp (ArrayLit es intype loc) = do
  es' <- mapM transformExp es
  case transformType intype of
    Tuple ets _ -> do
      (e, bindings) <- foldM comb (id, replicate (length ets) []) es'
      e <$> tuparrexp (map reverse bindings) ets
        where comb (acce, bindings) e = do
                names <- map fst <$> mapM (newVar "array_tup") ets
{'fraction_non_alphanumeric': 0.08615384615384615, 'fraction_numerical': 0.0010702341137123746, 'mean_word_length': 3.1812080536912752, 'pattern_counts': {'":': 0, '<': 24, '<?xml version=': 0, '>': 48, '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': '6412544', 'n_tokens_mistral': 2276, 'n_tokens_neox': 2187, 'n_words': 845}