{-# 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.Abs
knownAtomsList :: [(String, String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState))]
knownAtomsList :: [(String,
String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState))]
knownAtomsList =
[ (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_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_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
Right 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
Left 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 -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> 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 -> Int
bytesToInt Bytes -> Object
wrapBytesInBytes (String -> Object -> Object
extractLabel String
"start") (String -> Object -> Object
extractLabel String
"len") (Bytes -> Int -> Int -> Bytes
sliceBytes Bytes
bytes) String
name Object
obj EvaluationState
state
)
, (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_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_xor", (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> DataizeChain (Object, EvaluationState)
evaluateBytesBytesBytesFunChain Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.^.))
, (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_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_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_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
(>))
, (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
(*))
, (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
(+))
, (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
(/))
, (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
(>))
, (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
(*))
, (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
(+))
, (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
(/))
,
(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
wrapBytesInInt 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
Right 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
Left 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 -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> 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 -> Int
bytesToInt Bytes -> Object
wrapBytesInString (String -> Object -> Object
extractLabel String
"start") (String -> Object -> Object
extractLabel String
"len") (\Int
start Int
len -> Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
len (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
start String
string)) String
name Object
obj EvaluationState
state
)
,
(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)
, (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)
,
( 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
forall a b. a -> Either a b
Left (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
)
]