<commit_before>-- "src/Dao/Object.hs"  declares the "Object" data type which is the
-- fundamental data type used througout the Dao System.
-- 
-- Copyright (C) 2008-2012  <NAME>.
-- This file is part of the Dao System.
--
-- The Dao System is free software: you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or (at your option) any later version.
-- 
-- The Dao System is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program (see the file called "LICENSE"). If not, see
-- <http://www.gnu.org/licenses/agpl.html>.


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}

module Dao.Object
  ( module Dao.String
  , module Dao.Object
  ) where

import           Dao.String
import           Dao.Pattern
import           Dao.Tree as T

import           Numeric

import           Data.Typeable
import           Data.Dynamic
import           Data.Maybe
import           Data.Either
import           Data.List
import           Data.Complex
import           Data.Int
import           Data.Char
import           Data.Word
import           Data.Ratio
import           Data.Array.IArray
import           Data.Time hiding (parseTime)

import qualified Data.Map                  as M
import qualified Data.IntMap               as I
import qualified Data.Set                  as S
import qualified Data.ByteString.Lazy      as B

import           Control.Exception

----------------------------------------------------------------------------------------------------

showEncoded :: [Word8] -> String
showEncoded encoded = seq encoded (concatMap (\b -> showHex b " ") encoded)

type T_int      = Int64
type T_word     = Word64
type T_long     = Integer
type T_ratio    = Rational
type T_complex  = Complex T_float
type T_float    = Double
type T_time     = UTCTime
type T_diffTime = NominalDiffTime
type T_char     = Char
type T_string   = UStr
type T_ref      = Reference
type T_pair     = (Object, Object)
type T_list     = [Object]
type T_set      = S.Set Object
type T_array_ix = T_int
type T_array    = Array T_array_ix Object
type T_intMap   = I.IntMap Object
type T_dict     = M.Map Name Object
type T_tree     = T.Tree Name Object
type T_pattern  = Pattern
type T_rule     = Rule
type T_script   = Script
type T_bytes    = B.ByteString

data TypeID
  = NullType
  | TrueType
  | TypeType
  | IntType
  | WordType
  | LongType
  | FloatType
  | RatioType
  | ComplexType
  | TimeType
  | DiffTimeType
  | CharType
  | StringType
  | PairType
  | RefType
  | ListType
  | SetType
  | ArrayType
  | IntMapType
  | DictType
  | TreeType
  | PatternType
  | ScriptType
  | RuleType
  | BytesType
  deriving (Eq, Ord, Show, Enum, Typeable)

-- | References used throughout the executable script refer to differer places in the Runtime where
-- values can be stored. Because each store is accessed slightly differently, it is necessary to
-- declare, in the abstract syntax tree (AST) representation of the script exactly why types of
-- variables are being accessed so the appropriate read, write, or update action can be planned.
data Reference
  = IntRef     { intRef    :: Int }  -- ^ reference to a read-only pattern-match variable.
  | LocalRef   { localRef  :: Name } -- ^ reference to a local variable.
  | StaticRef  { localRef  :: Name } -- ^ reference to a permanent static variable (stored per rule/function).
  | QTimeRef   { globalRef :: [Name] } -- ^ reference to a query-time static variable.
  | GlobalRef  { globalRef :: [Name] } -- ^ reference to in-memory data stored per 'Dao.Types.ExecUnit'.
  | ProgramRef { progID    :: Name , subRef    :: Name   } -- ^ reference to a portion of a 'Dao.Types.Program'.
  | FileRef    { fileID    :: UPath, globalRef :: [Name] } -- ^ reference to a variable in a 'Dao.Types.File'
  | Subscript  { dereference :: Reference, subscriptValue :: Object } -- ^ reference to value at a subscripted slot in a container object
  | MetaRef    { dereference :: Reference } -- ^ wraps up a 'Reference' as a value that cannot be used as a reference.
  deriving (Eq, Ord, Show, Typeable)

refSameClass :: Reference -> Reference -> Bool
refSameClass a b = case (a, b) of<commit_msg>'Dao.Object.Object' now instantiates Num, Integral, Real, Frac, RealFrac and Floating, allowing virtually all mathematical functions to be applied directly to the Object data type without applying conversions.<commit_after>-- "src/Dao/Object.hs"  declares the "Object" data type which is the
-- fundamental data type used througout the Dao System.
-- 
-- Copyright (C) 2008-2012  <NAME>.
-- This file is part of the Dao System.
--
-- The Dao System is free software: you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or (at your option) any later version.
-- 
-- The Dao System is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program (see the file called "LICENSE"). If not, see
-- <http://www.gnu.org/licenses/agpl.html>.


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}

module Dao.Object
  ( module Dao.String
  , module Dao.Object
  ) where

import           Dao.String
import           Dao.Pattern
import           Dao.Tree as T

import           Numeric

import           Data.Typeable
import           Data.Dynamic
import           Data.Maybe
import           Data.Either
import           Data.List
import           Data.Complex
import           Data.Int
import           Data.Char
import           Data.Word
import           Data.Ratio
import           Data.Array.IArray
import           Data.Time hiding (parseTime)

import qualified Data.Map                  as M
import qualified Data.IntMap               as I
import qualified Data.Set                  as S
import qualified Data.ByteString.Lazy      as B

import           Control.Exception

----------------------------------------------------------------------------------------------------

showEncoded :: [Word8] -> String
showEncoded encoded = seq encoded (concatMap (\b -> showHex b " ") encoded)

type T_int      = Int64
type T_word     = Word64
type T_long     = Integer
type T_ratio    = Rational
type T_complex  = Complex T_float
type T_float    = Double
type T_time     = UTCTime
type T_diffTime = NominalDiffTime
type T_char     = Char
type T_string   = UStr
type T_ref      = Reference
type T_pair     = (Object, Object)
type T_list     = [Object]
type T_set      = S.Set Object
type T_array_ix = T_int
type T_array    = Array T_array_ix Object
type T_intMap   = I.IntMap Object
type T_dict     = M.Map Name Object
type T_tree     = T.Tree Name Object
type T_pattern  = Pattern
type T_rule     = Rule
type T_script   = Script
type T_bytes    = B.ByteString

data TypeID
  = NullType
  | TrueType
  | TypeType
  | IntType
  | WordType
  | DiffTimeType
  | FloatType
  | LongType
  | RatioType
  | ComplexType
  | TimeType
  | CharType
  | StringType
  | PairType
  | RefType
  | ListType
  | SetType
  | ArrayType
  | IntMapType
  | DictType
  | TreeType
  | PatternType
  | ScriptType
  | RuleType
  | BytesType
  deriving (Eq, Ord, Show, Enum, Typeable)

----------------------------------------------------------------------------------------------------

oBool :: Bool -> Object
oBool a = if a then OTrue else OFalse

isNumeric :: Object -> Bool
isNumeric o = case o of
  OWord     _ -> True
  OInt      _ -> True
  OLong     _ -> True
  ODiffTime _ -> True
  OFloat    _ -> True
  ORatio    _ -> True
  OComplex  _ -> True
  _           -> False

isIntegral :: Object -> Bool
isIntegral o = case o of
  OWord _ -> True
  OInt  _ -> True
  OLong _ -> True
  _       -> False

isRational :: Object -> Bool
isRational o = case o of
  OWord     _ -> True
  OInt      _ -> True
  OLong     _ -> True
  ODiffTime _ -> True
  OFloat    _ -> True
  ORatio    _ -> True
  _           -> False

isFloating :: Object -> Bool
isFloating o = case o of
  OFloat   _ -> True
  OComplex _ -> True
  _          -> False

objToIntegral :: Object -> Maybe T_long
objToIntegral o = case o of
  OWord o -> return $ toIntegral o
  OInt  o -> return $ toIntegral o
  OLong o -> return o
  _       -> mzero

objToRational :: Object -> Maybe T_rational
objToRational o = case o of
  OWord     o -> return $ toRational o
  OInt      o -> return $ toRational o
  ODiffTime o -> return $ toRational o
  OFloat    o -> return $ toRational o
  OLong     o -> return $ toRational o
  ORatio    o -> return o
  _           -> mzero

instance Real Object where
  toRational o = fromMaybe ONull (objToRational o)

objToComplex :: Object -> Maybe T_complex
objToComplex o = case o of
  T_complex o -> return o
  o           -> objToRational o >>= \o -> return (fromRational o :+ 0)

fitIntToBounds :: Bounded a => a -> a -> (a -> Object) -> T_long -> Maybe Object
fitIntToBounds minb maxb construct a =
  if fromIntegral minb <= a && a <= fromIntegral maxb
    then return (construct (fromIntegral a))
    else mzero

objToFloat :: Object -> Maybe T_float
objToFloat = OFloat . fromRational . objToRational

instance Num Object where
  a + b = fromMaybe ONull $ msum $
    [ objToIntegral a >>= \a -> objToIntegral b -> fitIntBounds (a+b)
    , objToRational a >>= \a -> objToRational b -> ORational (a+b)
    , objToComplex  a >>= \a -> objToComplex  b -> OComplex (a+b)
    ]
  a - b = fromMaybe ONull $ msum $
    [ objToIntegral a >>= \a -> objToIntegral b -> fitIntBounds (a-b)
    , objToRational a >>= \a -> objToRational b -> ORational (a-b)
    , objToComplex  a >>= \a -> objToComplex  b -> OComplex (a-b)
    ]
  a * b = fromMaybe ONull $ msum $
    [ objToIntegral a >>= \a -> objToIntegral b -> fitIntBounds (a*b)
    , objToRational a >>= \a -> objToRational b -> ORational (a*b)
    , objToComplex  a >>= \a -> objToComplex  b -> OComplex (a*b)
    ]
  signum a = fromMaybe ONull $
    objToRational a >>= \a ->
      return (if a==0 then OInt 0 else if a>0 then OInt 1 else OInt (0-1))
  abs a = case a of
    OWord     a -> OWord a
    OInt      a -> OInt (abs a)
    OLong     a -> OLong (abs a)
    ODiffTime a -> ODiffTime (abs a)
    OFloat    a -> OFloat (abs a)
    ORatio    a -> ORatio (abs a)
    OComplex  a -> OFloat (magnitude a)
    _           -> ONull
  fromInteger = OLong

instance Fractional Object where
  a / b = fromMaybe ONull $ msum $
    [ case (a, b) of
        (OFloat a, OFloat b) -> OFloat (a/b)
        _                    -> mzero
    , objToRational a >>= \a -> objToRational b >>= \b -> return (a/b)
    , objToComplex  a >>= \a -> objToComplex  b >>= \b -> return (a/b)
    ]
  recip a = fromMaybe ONull $ msum $
    [ case a of
        OFloat   a -> return (OFloat   (recip a))
        OComplex a -> return (OComplex (recip a))
        _          -> mzero
    , fmap (ORatio . recip) (objToRational a)
    ]

instance Floating Object where
  pi = OFloat pi
  exp a = fromMaybe ONull (mplus (fmap (OFloat . exp) (objToFloat a)) (fmap (OComplex . exp) (objToComplex a)))
  sqrt a = fromMaybe ONull (mplus (fmap (OFloat . sqrt) (objToFloat a)) (fmap (OComplex . sqrt) (objToComplex a)))
  log a = fromMaybe ONull (mplus (fmap (OFloat . log) (objToFloat a)) (fmap (OComplex . log) (objToComplex a)))
  sin a = fromMaybe ONull (mplus (fmap (OFloat . sin) (objToFloat a)) (fmap (OComplex . sin) (objToComplex a)))
  cos a = fromMaybe ONull (mplus (fmap (OFloat . cos) (objToFloat a)) (fmap (OComplex . cos) (objToComplex a)))
  tan a = fromMaybe ONull (mplus (fmap (OFloat . tan) (objToFloat a)) (fmap (OComplex . tan) (objToComplex a)))
  asin a = fromMaybe ONull (mplus (fmap (OFloat . asin) (objToFloat a)) (fmap (OComplex . asin) (objToComplex a)))
  acos a = fromMaybe ONull (mplus (fmap (OFloat . acos) (objToFloat a)) (fmap (OComplex . acos) (objToComplex a)))
  atan a = fromMaybe ONull (mplus (fmap (OFloat . atan) (objToFloat a)) (fmap (OComplex . atan) (objToComplex a)))
  sinh a = fromMaybe ONull (mplus (fmap (OFloat . sinh) (objToFloat a)) (fmap (OComplex . sinh) (objToComplex a)))
  cosh a = fromMaybe ONull (mplus (fmap (OFloat . cosh) (objToFloat a)) (fmap (OComplex . cosh) (objToComplex a)))
  tanh a = fromMaybe ONull (mplus (fmap (OFloat . tanh) (objToFloat a)) (fmap (OComplex . tanh) (objToComplex a)))
  asinh a = fromMaybe ONull (mplus (fmap (OFloat . asinh) (objToFloat a)) (fmap (OComplex . asinh) (objToComplex a)))
  acosh a = fromMaybe ONull (mplus (fmap (OFloat . acosh) (objToFloat a)) (fmap (OComplex . acosh) (objToComplex a)))
  atanh a = fromMaybe ONull (mplus (fmap (OFloat . atanh) (objToFloat a)) (fmap (OComplex . atanh) (objToComplex a)))
  a ** b = fromMaybe ONull $ msum $
    [ objToFloat a >>= \a -> objToFloat b >>= \b -> return (OFloat (a**b))
    , objToComplex a >>= \a -> objToComplex b >>= \b -> return (OComplex (a**b))
    ]
  logBase a b = fromMaybe ONull $ msum $
    [ objToFloat a >>= \a -> objToFloat b >>= \b -> return (OFloat (logBase a b)
    , objToComplex a >>= \a -> objToComplex b >>= \b -> return (OComplex (logBase a b))
    ]

instance Integral Object where
  toInteger o = case o of
    OInt  o -> toInteger o
    OWord o -> toInteger o
    OLong o -> o
  quotRem a b = fromMaybe ONull $
    objToIntegral a >>= \a -> objToIntegral >>= \b -> return (quotRem a b)

instance RealFrac Object where
  properFraction a = fromMaybe ONull $ msum $
    [ objToIntegral a >>= \a -> return (a, OWord 0)
    , objToRational a >>= \a -> let (i, f) = properFraction a in (i, ORatio f)
    ]

----------------------------------------------------------------------------------------------------

-- | References used throughout the executable script refer to differer places in the Runtime where
-- values can be stored. Because each store is accessed slightly differently, it is necessary to
-- declare, in the abstract syntax tree (AST) representation of the script exactly why types of
-- variables are being accessed so the appropriate read, write, or update action can be planned.
data Reference
  = IntRef     { intRef    :: Int }  -- ^ reference to a read-only pattern-match variable.
  | LocalRef   { localRef  :: Name } -- ^ reference to a local variable.
  | StaticRef  { localRef  :: Name } -- ^ reference to a permanent static variable (stored per rule/function).
  | QTimeRef   { globalRef :: [Name] } -- ^ reference to a query-time static variable.
  | GlobalRef  { globalRef :: [Name] } -- ^ reference to in-memory data stored per 'Dao.Types.ExecUnit'.
  | ProgramRef { progID    :: Name , subRef    :: Name   } -- ^ reference to a portion of a 'Dao.Types.Program'.
  | FileRef    { fileID    :: UPath, globalRef :: [Name] } -- ^ reference to a variable in a 'Dao.Types.File'
  | Subscript  { dereference :: Reference, subscriptValue :: Object } -- ^ reference to value at a subscripted slot in a container object
  | MetaRef    { dereference :: Reference } -- ^ wraps up a 'Reference' as a value that cannot be used as a reference.
  deriving (Eq, Ord, Show, Typeable)

refSameClass :: Reference -> Reference -> Bool
refSameClass a b = case (a, b) of
{'fraction_non_alphanumeric': 0.1224009664907484, 'fraction_numerical': 0.002416226870986202, 'mean_word_length': 2.3499467518636847, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 172, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, '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': '719796', 'n_tokens_mistral': 4930, 'n_tokens_neox': 4866, 'n_words': 1820}