<commit_before>{-# LANGUAGE TemplateHaskell #-}

module Database.DSH.VL.Opt.Properties.Const
    ( inferConstVecNullOp
    , inferConstVecUnOp
    , inferConstVecBinOp
    , inferConstVecTerOp
    ) where

import           Control.Monad
import           Data.List
import qualified Data.List.NonEmpty                          as N
import           Data.Maybe

import Database.DSH.Common.Impossible
import           Database.DSH.VL.Opt.Properties.Common
import           Database.DSH.VL.Opt.Properties.Types
import           Database.DSH.VL.Lang
import           Database.DSH.Common.Lang

unp :: Show a => VectorProp a -> Either String a
unp = unpack "Properties.Const"

fromDBV :: ConstVec -> Either String (ConstDescr, [ConstPayload])
fromDBV (DBVConst d ps)   = Right (d, ps)
fromDBV x                 = Left $ "Properties.Const fromDBV " ++ (show x)

fromRVec :: ConstVec -> Either String (SourceConstDescr, TargetConstDescr)
fromRVec (RenameVecConst s t) = Right (s, t)
fromRVec x                    = Left ("Properties.Const fromRVec " ++ (show x))

fromPVec :: ConstVec -> Either String (SourceConstDescr, TargetConstDescr)
fromPVec (PropVecConst s t)  = Right (s, t)
fromPVec _                   = Left "Properties.Const fromPVec"

--------------------------------------------------------------------------------
-- Evaluation of constant expressions

-- FIXME finish remaining cases, only integer numeric operations so
-- far.

mkEnv :: [ConstPayload] -> [(DBCol, VLVal)]
mkEnv constCols = mapMaybe envEntry $ zip [1..] constCols
  where
    envEntry :: (DBCol, ConstPayload) -> Maybe (DBCol, VLVal)
    envEntry (_, NonConstPL) = mzero
    envEntry (c, ConstPL v)  = return (c, v)

evalNumOp :: BinNumOp -> Int -> Int -> Int
evalNumOp op v1 v2 =
    case op of
        Add -> v1 + v2
        Sub -> v1 - v2
        Div -> v1 `div` v2
        Mul -> v1 * v2
        Mod -> v1 `mod` v2

evalBinOp :: ScalarBinOp -> VLVal -> VLVal -> Maybe VLVal
evalBinOp (SBNumOp nop)  (VLInt i1) (VLInt i2)     = return $ VLInt $ evalNumOp nop i1 i2
evalBinOp (SBRelOp _)    (VLInt _)  (VLInt _)      = mzero
evalBinOp _              (VLInt _)  (VLInt _)      = $impossible
evalBinOp (SBBoolOp _)   (VLBool _) (VLBool _)     = mzero
evalBinOp  _             (VLBool _) (VLBool _)     = $impossible
evalBinOp (SBStringOp _) (VLString _) (VLString _) = mzero
evalBinOp _              (VLString _) (VLString _) = $impossible
evalBinOp (SBRelOp _)    (VLDouble _) (VLDouble _) = mzero
evalBinOp (SBNumOp _)    (VLDouble _) (VLDouble _) = mzero
evalBinOp _              (VLDouble _) (VLDouble _) = $impossible
evalBinOp _              VLUnit       VLUnit       = $impossible
evalBinOp (SBDateOp _)   _            _            = mzero
evalBinOp _              _            _            = $impossible

evalUnOp :: ScalarUnOp -> VLVal -> Maybe VLVal
evalUnOp _ _ = mzero

constExpr :: [ConstPayload] -> Expr -> Either String ConstPayload
constExpr constCols expr =
    case eval expr of
        Just v  -> return $ ConstPL v
        Nothing -> return NonConstPL

  where
    env :: [(DBCol, VLVal)]
    env = mkEnv constCols

    eval :: Expr -> Maybe VLVal
    eval (Constant v)      = return v
    eval (Column i)        = lookup i env
    eval (BinApp op e1 e2) = do
        v1 <- eval e1
        v2 <- eval e2
        evalBinOp op v1 v2
    eval (UnApp op e1)     = do
        v <- eval e1<commit_msg>Fixed constant inference for VL plans.<commit_after>{-# LANGUAGE TemplateHaskell #-}

module Database.DSH.VL.Opt.Properties.Const
    ( inferConstVecNullOp
    , inferConstVecUnOp
    , inferConstVecBinOp
    , inferConstVecTerOp
    ) where

import           Control.Monad
import           Data.List
import qualified Data.List.NonEmpty                          as N
import           Data.Maybe

import Database.DSH.Common.Impossible
import           Database.DSH.VL.Opt.Properties.Common
import           Database.DSH.VL.Opt.Properties.Types
import           Database.DSH.VL.Lang
import           Database.DSH.Common.Lang

unp :: Show a => VectorProp a -> Either String a
unp = unpack "Properties.Const"

fromDBV :: ConstVec -> Either String (ConstDescr, [ConstPayload])
fromDBV (DBVConst d ps)   = Right (d, ps)
fromDBV x                 = Left $ "Properties.Const fromDBV " ++ (show x)

fromRVec :: ConstVec -> Either String (SourceConstDescr, TargetConstDescr)
fromRVec (RenameVecConst s t) = Right (s, t)
fromRVec x                    = Left ("Properties.Const fromRVec " ++ (show x))

fromPVec :: ConstVec -> Either String (SourceConstDescr, TargetConstDescr)
fromPVec (PropVecConst s t)  = Right (s, t)
fromPVec _                   = Left "Properties.Const fromPVec"

--------------------------------------------------------------------------------
-- Evaluation of constant expressions

-- FIXME finish remaining cases, only integer numeric operations so
-- far.

mkEnv :: [ConstPayload] -> [(DBCol, VLVal)]
mkEnv constCols = mapMaybe envEntry $ zip [1..] constCols
  where
    envEntry :: (DBCol, ConstPayload) -> Maybe (DBCol, VLVal)
    envEntry (_, NonConstPL) = mzero
    envEntry (c, ConstPL v)  = return (c, v)

evalNumOp :: BinNumOp -> Int -> Int -> Int
evalNumOp op v1 v2 =
    case op of
        Add -> v1 + v2
        Sub -> v1 - v2
        Div -> v1 `div` v2
        Mul -> v1 * v2
        Mod -> v1 `mod` v2

evalBinOp :: ScalarBinOp -> VLVal -> VLVal -> Maybe VLVal
evalBinOp (SBNumOp nop)  (VLInt i1) (VLInt i2)       = return $ VLInt $ evalNumOp nop i1 i2
evalBinOp (SBNumOp _)    (VLDouble _) (VLDouble _)   = mzero
evalBinOp (SBNumOp _)    (VLDecimal _) (VLDecimal _) = mzero

evalBinOp (SBRelOp _)    (VLInt _)  (VLInt _)        = mzero
evalBinOp (SBRelOp _)    (VLDouble _) (VLDouble _)   = mzero
evalBinOp (SBRelOp _)    (VLDecimal _) (VLDecimal _) = mzero
evalBinOp (SBRelOp _)    (VLString _) (VLString _)   = mzero
evalBinOp (SBRelOp _)    (VLDate _) (VLDate _)       = mzero

evalBinOp (SBBoolOp _)   (VLBool _) (VLBool _)       = mzero
evalBinOp (SBStringOp _) (VLString _) (VLString _)   = mzero
evalBinOp (SBDateOp _)   (VLDate _) (VLDate _)       = mzero
evalBinOp _              _            _              = $impossible

evalUnOp :: ScalarUnOp -> VLVal -> Maybe VLVal
evalUnOp _ _ = mzero

constExpr :: [ConstPayload] -> Expr -> Either String ConstPayload
constExpr constCols expr =
    case eval expr of
        Just v  -> return $ ConstPL v
        Nothing -> return NonConstPL

  where
    env :: [(DBCol, VLVal)]
    env = mkEnv constCols

    eval :: Expr -> Maybe VLVal
    eval (Constant v)      = return v
    eval (Column i)        = lookup i env
    eval (BinApp op e1 e2) = do
        v1 <- eval e1
        v2 <- eval e2
        evalBinOp op v1 v2
    eval (UnApp op e1)     = do
        v <- eval e1
{'fraction_non_alphanumeric': 0.12065894924309885, 'fraction_numerical': 0.008014247551202136, 'mean_word_length': 2.114140480591497, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 53, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3006932', 'n_tokens_mistral': 2224, 'n_tokens_neox': 2192, 'n_words': 632}