{- FOURMOLU_DISABLE -}
-- The MIT License (MIT)

-- Copyright (c) 2016-2024 Objectionary.com

-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:

-- The above copyright notice and this permission notice shall be included
-- in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.
{- FOURMOLU_ENABLE -}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.EO.Phi.Dataize.Atoms where

import Data.Bits
import Data.List (singleton)
import Language.EO.Phi.Dataize
import Language.EO.Phi.Rules.Common
import Language.EO.Phi.Syntax

knownAtomsList :: [(String, String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState))]
knownAtomsList :: [(String,
  String
  -> Object
  -> EvaluationState
  -> DataizeChain (Object, EvaluationState))]
knownAtomsList =
  -- [ ("Lorg_eolang_as_phi", _)
  [ (String
"Lorg_eolang_int_gt", (Int -> Int -> Bool)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntBoolFunChain Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>))
  , (String
"Lorg_eolang_int_plus", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntIntFunChain Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
  , (String
"Lorg_eolang_int_times", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntIntFunChain Int -> Int -> Int
forall a. Num a => a -> a -> a
(*))
  , (String
"Lorg_eolang_int_div", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntIntFunChain Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot)
  , (String
"Lorg_eolang_bytes_and", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBytesBytesBytesFunChain Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.))
  , (String
"Lorg_eolang_bytes_concat", (Bytes -> Bytes)
-> (Bytes -> Bytes)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Bytes -> Bytes -> Bytes)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bytes -> Bytes
forall a. a -> a
id Bytes -> Bytes
forall a. a -> a
id Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"b") Bytes -> Bytes -> Bytes
concatBytes)
  , (String
"Lorg_eolang_bytes_eq", (Bool -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> Bool)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bool -> Bytes
boolToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesAsBool Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"b") Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==))
  , (String
"Lorg_eolang_bytes_not", (Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBytesBytesFunChain Int -> Int
forall a. Bits a => a -> a
complement)
  , (String
"Lorg_eolang_bytes_or", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBytesBytesBytesFunChain Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.))
  , (String
"Lorg_eolang_bytes_right", (Int -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x") (\Int
x Int
i -> Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shift Int
x (-Int
i)))
  ,
    ( String
"Lorg_eolang_bytes_size"
    , let f :: String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
f = (Int -> Bytes)
-> (Bytes -> Bytes)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Bytes -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> Bytes
forall a. a -> a
id Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (\(Bytes String
bytes) -> [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
words ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
dashToSpace String
bytes)))
           where
            dashToSpace :: Char -> Char
dashToSpace Char
'-' = Char
' '
            dashToSpace Char
c = Char
c
       in String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
f
    )
  ,
    ( String
"Lorg_eolang_bytes_slice"
    , \String
name Object
obj EvaluationState
state -> do
        Either Object Bytes
thisStr <- Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall info a. Chain info a -> Chain info a
incLogLevel (Chain (Either Object Bytes) (Either Object Bytes)
 -> Chain (Either Object Bytes) (Either Object Bytes))
-> Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True (Object -> Object
extractRho Object
obj)
        Bytes
bytes <- case Either Object Bytes
thisStr of
          AsBytes Bytes
bytes -> Bytes -> Chain (Either Object Bytes) Bytes
forall a. a -> Chain (Either Object Bytes) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes
bytes
          AsObject Object
_ -> String -> Chain (Either Object Bytes) Bytes
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Couldn't find bytes"
        (Bytes -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Double -> Double -> Bytes)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bytes -> Bytes
forall a. a -> a
id Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInBytes (String -> Object -> Object
extractLabel String
"start") (String -> Object -> Object
extractLabel String
"len") (\Double
start Double
len -> Bytes -> Int -> Int -> Bytes
sliceBytes Bytes
bytes (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
start) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
len)) String
name Object
obj EvaluationState
state
    )
  , (String
"Lorg_eolang_bytes_xor", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBytesBytesBytesFunChain Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.^.))
  , -- deprecated
    (String
"Lorg_eolang_dataized", (Bytes -> Bytes)
-> (Bytes -> Bytes)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Bytes -> Bytes)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Bytes -> Bytes
forall a. a -> a
id Bytes -> Bytes
forall a. a -> a
id Bytes -> Object
wrapBytesInBytes (String -> Object -> Object
extractLabel String
"target") Bytes -> Bytes
forall a. a -> a
id)
  , -- , ("Lorg_eolang_cage_encaged_encage", _)
    -- , ("Lorg_eolang_cage_encaged_φ", _)
    -- , ("Lorg_eolang_cage_φ", _)
    (String
"Lorg_eolang_error", (String -> Bytes)
-> (Bytes -> String)
-> (Bytes -> Object)
-> (Object -> Object)
-> (String -> String)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain String -> Bytes
stringToBytes Bytes -> String
bytesToString Bytes -> Object
wrapBytesInBytes (String -> Object -> Object
extractLabel String
"message") String -> String
forall a. HasCallStack => String -> a
error)
  , -- float
    -- deprecated
    (String
"Lorg_eolang_float_gt", (Bool -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Double -> Double -> Bool)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bool -> Bytes
boolToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x") Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(>))
  , -- deprecated
    (String
"Lorg_eolang_float_times", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Num a => a -> a -> a
(*))
  , -- deprecated
    (String
"Lorg_eolang_float_plus", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Num a => a -> a -> a
(+))
  , -- deprecated
    (String
"Lorg_eolang_float_div", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/))
  , -- deprecated
    (String
"Lorg_eolang_float_gt", (Bool -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Double -> Double -> Bool)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bool -> Bytes
boolToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x") Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(>))
  , -- deprecated
    (String
"Lorg_eolang_float_times", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Num a => a -> a -> a
(*))
  , -- deprecated
    (String
"Lorg_eolang_float_plus", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Num a => a -> a -> a
(+))
  , -- deprecated
    (String
"Lorg_eolang_float_div", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/))
  , -- , ("Lorg_eolang_fs_dir_made_mkdir", _)
    -- , ("Lorg_eolang_fs_dir_tmpfile_touch", _)
    -- , ("Lorg_eolang_fs_dir_walk", _)
    -- , ("Lorg_eolang_fs_file_deleted_delete", _)
    -- , ("Lorg_eolang_fs_file_exists", _)
    -- , ("Lorg_eolang_fs_file_is_directory", _)
    -- , ("Lorg_eolang_fs_file_moved_move", _)
    -- , ("Lorg_eolang_fs_file_open_file_stream_read_read_bytes", _)
    -- , ("Lorg_eolang_fs_file_open_file_stream_write_written_bytes", _)
    -- , ("Lorg_eolang_fs_file_open_process_file", _)
    -- , ("Lorg_eolang_fs_file_size", _)
    -- , ("Lorg_eolang_fs_file_touched_touch", _)
    (String
"Lorg_eolang_i16_as_i32", (Int16 -> Bytes)
-> (Bytes -> Int64)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Int64 -> Int16)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int16 -> Bytes
int16ToBytes Bytes -> Int64
bytesToInt64 Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho Int64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  , (String
"Lorg_eolang_i32_as_i64", (Int32 -> Bytes)
-> (Bytes -> Int64)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Int64 -> Int32)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int32 -> Bytes
int32ToBytes Bytes -> Int64
bytesToInt64 Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  , (String
"Lorg_eolang_i64_as_number", (Double -> Bytes)
-> (Bytes -> Int64)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Int64 -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Int64
bytesToInt64 Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  , (String
"Lorg_eolang_i64_div", (Int -> Int -> Maybe Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntMaybeIntFunChain (\Int
x Int
y -> if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
y)))
  , (String
"Lorg_eolang_i64_gt", (Int -> Int -> Bool)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntBoolFunChain Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>))
  , (String
"Lorg_eolang_i64_plus", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntIntFunChain Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
  , (String
"Lorg_eolang_i64_times", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateIntIntIntFunChain Int -> Int -> Int
forall a. Num a => a -> a -> a
(*))
  , -- , ("Lorg_eolang_malloc_of_allocated_read", _)
    -- , ("Lorg_eolang_malloc_of_allocated_resize", _)
    -- , ("Lorg_eolang_malloc_of_allocated_size", _)
    -- , ("Lorg_eolang_malloc_of_allocated_write", _)
    -- , ("Lorg_eolang_malloc_of_φ", _)
    (String
"Lorg_eolang_math_angle_cos", (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho Double -> Double
forall a. Floating a => a -> a
cos)
  , (String
"Lorg_eolang_math_angle_sin", (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho Double -> Double
forall a. Floating a => a -> a
sin)
  , (String
"Lorg_eolang_math_real_acos", (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho Double -> Double
forall a. Floating a => a -> a
acos)
  , (String
"Lorg_eolang_math_real_asin", (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho Double -> Double
forall a. Floating a => a -> a
asin)
  , (String
"Lorg_eolang_math_real_ln", (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho Double -> Double
forall a. Floating a => a -> a
log)
  , (String
"Lorg_eolang_math_real_pow", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Floating a => a -> a -> a
(**))
  , (String
"Lorg_eolang_math_real_sqrt", (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho Double -> Double
forall a. Floating a => a -> a
sqrt)
  , (String
"Lorg_eolang_number_as_i64", (Int64 -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Int64)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int64 -> Bytes
int64ToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
  , (String
"Lorg_eolang_number_div", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/))
  , (String
"Lorg_eolang_number_floor", (Int64 -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Double -> Int64)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int64 -> Bytes
int64ToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor)
  , (String
"Lorg_eolang_number_gt", (Bool -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Double -> Double -> Bool)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bool -> Bytes
boolToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x") Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(>))
  , (String
"Lorg_eolang_number_plus", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Num a => a -> a -> a
(+))
  , (String
"Lorg_eolang_number_times", (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain Double -> Double -> Double
forall a. Num a => a -> a -> a
(*))
  , -- , ("Lorg_eolang_rust", _)
    -- string
    (String
"Lorg_eolang_string_length", (Int -> Bytes)
-> (Bytes -> String)
-> (Bytes -> Object)
-> (Object -> Object)
-> (String -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> String
bytesToString Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
  ,
    ( String
"Lorg_eolang_string_slice"
    , \String
name Object
obj EvaluationState
state -> do
        Either Object Bytes
thisStr <- Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall info a. Chain info a -> Chain info a
incLogLevel (Chain (Either Object Bytes) (Either Object Bytes)
 -> Chain (Either Object Bytes) (Either Object Bytes))
-> Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True (Object -> Object
extractRho Object
obj)
        String
string <- case Either Object Bytes
thisStr of
          AsBytes Bytes
bytes -> String -> Chain (Either Object Bytes) String
forall a. a -> Chain (Either Object Bytes) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Chain (Either Object Bytes) String)
-> String -> Chain (Either Object Bytes) String
forall a b. (a -> b) -> a -> b
$ Bytes -> String
bytesToString Bytes
bytes
          AsObject Object
_ -> String -> Chain (Either Object Bytes) String
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Couldn't find bytes"
        (String -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Double -> Double -> String)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain String -> Bytes
stringToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstString (String -> Object -> Object
extractLabel String
"start") (String -> Object -> Object
extractLabel String
"len") (\Double
start Double
len -> Int -> String -> String
forall a. Int -> [a] -> [a]
take (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
len) (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
start) String
string)) String
name Object
obj EvaluationState
state
    )
  , -- others
    -- , ("Lorg_eolang_sys_os_name", _)
    -- , ("Lorg_eolang_sys_posix_φ", _)
    -- , ("Lorg_eolang_sys_win32_φ", _)
    -- , ("Lorg_eolang_try", _)
    -- , ("Lorg_eolang_txt_regex_compiled", _)
    -- , ("Lorg_eolang_txt_regex_pattern_match_matched_from_index", _)
    -- , ("Lorg_eolang_txt_sprintf", _)
    -- , ("Lorg_eolang_txt_sscanf", _)

    ( String
"Package"
    , let
        f :: String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
f String
_name obj :: Object
obj@(Formation [Binding]
bindings) = do
          \EvaluationState
state ->
            Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
              Chain (Either Object Bytes) Context
-> (Context -> DataizeChain (Object, EvaluationState))
-> DataizeChain (Object, EvaluationState)
forall a b.
Chain (Either Object Bytes) a
-> (a -> Chain (Either Object Bytes) b)
-> Chain (Either Object Bytes) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
                      Bool
True -> do
                        let ([Binding]
packageBindings, [Binding]
restBindings) = (Binding -> Bool) -> [Binding] -> ([Binding], [Binding])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Binding -> Bool
isPackage [Binding]
bindings
                        [Binding]
bs <- (Binding -> Chain (Either Object Bytes) Binding)
-> [Binding] -> Chain (Either Object Bytes) [Binding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Binding -> Chain (Either Object Bytes) Binding
dataizeBindingChain [Binding]
restBindings
                        String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataized 'Package' siblings" (Object -> Either Object Bytes
AsObject (Object -> Either Object Bytes) -> Object -> Either Object Bytes
forall a b. (a -> b) -> a -> b
$ [Binding] -> Object
Formation ([Binding]
bs [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
packageBindings))
                        (Object, EvaluationState) -> DataizeChain (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding] -> Object
Formation ([Binding]
bs [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
packageBindings), EvaluationState
state)
                      Bool
False ->
                        (Object, EvaluationState) -> DataizeChain (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding] -> Object
Formation [Binding]
bindings, EvaluationState
state)
                  )
                (Bool -> DataizeChain (Object, EvaluationState))
-> (Context -> Bool)
-> Context
-> DataizeChain (Object, EvaluationState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Bool
dataizePackage
         where
          isPackage :: Binding -> Bool
isPackage (LambdaBinding (Function String
"Package")) = Bool
True
          isPackage Binding
_ = Bool
False
          dataizeBindingChain :: Binding -> Chain (Either Object Bytes) Binding
dataizeBindingChain (AlphaBinding' Attribute
attr Object
o) = do
            Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
            let extendedContext :: Context
extendedContext = (Object -> Context -> Context
extendContextWith Object
obj Context
ctx){currentAttr = attr}
            Either Object Bytes
dataizationResult <- Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall info a. Chain info a -> Chain info a
incLogLevel (Chain (Either Object Bytes) (Either Object Bytes)
 -> Chain (Either Object Bytes) (Either Object Bytes))
-> Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ Context
-> Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall log a. Context -> Chain log a -> Chain log a
withContext Context
extendedContext (Chain (Either Object Bytes) (Either Object Bytes)
 -> Chain (Either Object Bytes) (Either Object Bytes))
-> Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
False Object
o
            Binding -> Chain (Either Object Bytes) Binding
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> Object -> Binding
AlphaBinding' Attribute
attr ((Object -> Object)
-> (Bytes -> Object) -> Either Object Bytes -> Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Object -> Object
forall a. a -> a
id ([Binding] -> Object
Formation ([Binding] -> Object) -> (Bytes -> [Binding]) -> Bytes -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> [Binding]
forall a. a -> [a]
singleton (Binding -> [Binding]) -> (Bytes -> Binding) -> Bytes -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Binding
DeltaBinding) Either Object Bytes
dataizationResult))
          dataizeBindingChain Binding
b = Binding -> Chain (Either Object Bytes) Binding
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return Binding
b
        f String
name Object
_otherwise = String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBuiltinFunChainUnknown String
name Object
_otherwise
       in
        String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
f
    )
  ]