{- 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 OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# HLINT ignore "Redundant fmap" #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Language.EO.Phi.Dataize where

import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (listToMaybe)
import Language.EO.Phi.Rules.Common
import Language.EO.Phi.Rules.Fast (fastYegorInsideOut)
import Language.EO.Phi.Rules.Yaml (substThis)
import Language.EO.Phi.Syntax
import PyF (fmt)
import System.IO.Unsafe (unsafePerformIO)

desugarAsBytes :: Either Object Bytes -> Either Object Bytes
desugarAsBytes :: Either Object Bytes -> Either Object Bytes
desugarAsBytes (Left Object
obj) = case Object
obj of
  ConstString String
s -> Bytes -> Either Object Bytes
forall a b. b -> Either a b
Right (String -> Bytes
stringToBytes String
s)
  ConstInt Integer
n -> Bytes -> Either Object Bytes
forall a b. b -> Either a b
Right (Int -> Bytes
intToBytes (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))
  f :: Object
f@ConstIntRaw{} -> Object -> Either Object Bytes
forall a. Object -> a
errorExpectedDesugaredObject Object
f
  ConstFloat Double
x -> Bytes -> Either Object Bytes
forall a b. b -> Either a b
Right (Double -> Bytes
floatToBytes Double
x)
  f :: Object
f@ConstFloatRaw{} -> Object -> Either Object Bytes
forall a. Object -> a
errorExpectedDesugaredObject Object
f
  Object
_ -> Object -> Either Object Bytes
forall a b. a -> Either a b
Left Object
obj
desugarAsBytes (Right Bytes
bytes) = Bytes -> Either Object Bytes
forall a b. b -> Either a b
Right Bytes
bytes

pattern AsBytes :: Bytes -> Either Object Bytes
pattern $mAsBytes :: forall {r}.
Either Object Bytes -> (Bytes -> r) -> ((# #) -> r) -> r
$bAsBytes :: Bytes -> Either Object Bytes
AsBytes bytes <- (desugarAsBytes -> Right bytes)
  where
    AsBytes Bytes
bytes = Bytes -> Either Object Bytes
forall a b. b -> Either a b
Right Bytes
bytes

pattern AsObject :: Object -> Either Object Bytes
pattern $mAsObject :: forall {r}.
Either Object Bytes -> (Object -> r) -> ((# #) -> r) -> r
$bAsObject :: Object -> Either Object Bytes
AsObject obj <- (desugarAsBytes -> Left obj)
  where
    AsObject Object
obj = Object -> Either Object Bytes
forall a b. a -> Either a b
Left Object
obj

{-# COMPLETE AsBytes, AsObject #-}

-- | Perform one step of dataization to the object (if possible).
dataizeStep :: Context -> Object -> (Context, Either Object Bytes)
dataizeStep :: Context -> Object -> (Context, Either Object Bytes)
dataizeStep Context
ctx Object
obj = ([LogEntry (Either Object Bytes)], (Context, Either Object Bytes))
-> (Context, Either Object Bytes)
forall a b. (a, b) -> b
snd (([LogEntry (Either Object Bytes)], (Context, Either Object Bytes))
 -> (Context, Either Object Bytes))
-> ([LogEntry (Either Object Bytes)],
    (Context, Either Object Bytes))
-> (Context, Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ [([LogEntry (Either Object Bytes)],
  (Context, Either Object Bytes))]
-> ([LogEntry (Either Object Bytes)],
    (Context, Either Object Bytes))
forall a. HasCallStack => [a] -> a
head ([([LogEntry (Either Object Bytes)],
   (Context, Either Object Bytes))]
 -> ([LogEntry (Either Object Bytes)],
     (Context, Either Object Bytes)))
-> [([LogEntry (Either Object Bytes)],
     (Context, Either Object Bytes))]
-> ([LogEntry (Either Object Bytes)],
    (Context, Either Object Bytes))
forall a b. (a -> b) -> a -> b
$ Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Context
-> [([LogEntry (Either Object Bytes)],
     (Context, Either Object Bytes))]
forall log result.
Chain log result -> Context -> [([LogEntry log], result)]
runChain (DataizeStepMode
-> Object
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
dataizeStepChain DataizeStepMode
DataizeAll Object
obj) Context
ctx -- FIXME: head is bad

dataizeStep' :: Context -> Object -> Either Object Bytes
dataizeStep' :: Context -> Object -> Either Object Bytes
dataizeStep' Context
ctx Object
obj = (Context, Either Object Bytes) -> Either Object Bytes
forall a b. (a, b) -> b
snd (Context -> Object -> (Context, Either Object Bytes)
dataizeStep Context
ctx Object
obj)

-- | Recursively perform normalization and dataization until we get bytes in the end.
dataizeRecursively :: Context -> Object -> Either Object Bytes
dataizeRecursively :: Context -> Object -> Either Object Bytes
dataizeRecursively Context
ctx Object
obj = ([LogEntry (Either Object Bytes)], Either Object Bytes)
-> Either Object Bytes
forall a b. (a, b) -> b
snd (([LogEntry (Either Object Bytes)], Either Object Bytes)
 -> Either Object Bytes)
-> ([LogEntry (Either Object Bytes)], Either Object Bytes)
-> Either Object Bytes
forall a b. (a -> b) -> a -> b
$ Context
-> Object
-> ([LogEntry (Either Object Bytes)], Either Object Bytes)
dataizeRecursivelyChain' Context
ctx Object
obj

dataizeStepChain' :: Context -> Object -> ([LogEntry (Either Object Bytes)], Either Object Bytes)
dataizeStepChain' :: Context
-> Object
-> ([LogEntry (Either Object Bytes)], Either Object Bytes)
dataizeStepChain' Context
ctx Object
obj = (Context, Either Object Bytes) -> Either Object Bytes
forall a b. (a, b) -> b
snd ((Context, Either Object Bytes) -> Either Object Bytes)
-> ([LogEntry (Either Object Bytes)],
    (Context, Either Object Bytes))
-> ([LogEntry (Either Object Bytes)], Either Object Bytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([LogEntry (Either Object Bytes)],
  (Context, Either Object Bytes))]
-> ([LogEntry (Either Object Bytes)],
    (Context, Either Object Bytes))
forall a. HasCallStack => [a] -> a
head (Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Context
-> [([LogEntry (Either Object Bytes)],
     (Context, Either Object Bytes))]
forall log result.
Chain log result -> Context -> [([LogEntry log], result)]
runChain (DataizeStepMode
-> Object
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
dataizeStepChain DataizeStepMode
DataizeAll Object
obj) Context
ctx) -- FIXME: head is bad

data DataizeStepMode = DataizeOnlyLambda | DataizeAll

-- | Perform one step of dataization to the object (if possible), reporting back individiual steps.
dataizeStepChain :: DataizeStepMode -> Object -> DataizeChain (Context, Either Object Bytes)
dataizeStepChain :: DataizeStepMode
-> Object
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
dataizeStepChain DataizeStepMode
mode obj :: Object
obj@(Formation [Binding]
bs)
  | DataizeStepMode
DataizeAll <- DataizeStepMode
mode
  , Just (DeltaBinding Bytes
bytes) <- [Binding] -> Maybe Binding
forall a. [a] -> Maybe a
listToMaybe [Binding
b | b :: Binding
b@(DeltaBinding Bytes
_) <- [Binding]
bs]
  , Bool -> Bool
not Bool
hasEmpty = do
      String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Found bytes" (Bytes -> Either Object Bytes
AsBytes Bytes
bytes)
      Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
      (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Bytes -> Either Object Bytes
AsBytes Bytes
bytes)
  | Just (LambdaBinding (Function String
funcName)) <- [Binding] -> Maybe Binding
forall a. [a] -> Maybe a
listToMaybe [Binding
b | b :: Binding
b@(LambdaBinding Function
_) <- [Binding]
bs]
  , Bool -> Bool
not Bool
hasEmpty = do
      Context
ctx' <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
      let lambaIsKnownAndNotEnabled :: Bool
lambaIsKnownAndNotEnabled = String
-> HashMap
     String
     (String
      -> Object
      -> EvaluationState
      -> Chain (Either Object Bytes) (Object, EvaluationState))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member String
funcName Context
ctx'.knownAtoms Bool -> Bool -> Bool
&& Bool -> Bool
not (String
-> HashMap
     String
     (String
      -> Object
      -> EvaluationState
      -> Chain (Either Object Bytes) (Object, EvaluationState))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member String
funcName Context
ctx'.enabledAtoms)
      if Bool
lambaIsKnownAndNotEnabled
        then do
          String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep [fmt|Not evaluating the lambda '{funcName}' since it's disabled.|] (Object -> Either Object Bytes
AsObject Object
obj)
          (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context
ctx', Object -> Either Object Bytes
AsObject Object
obj)
        else do
          String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep [fmt|Evaluating lambda '{funcName}' |] (Object -> Either Object Bytes
AsObject Object
obj)
          Chain (Either Object Bytes) (Object, EvaluationState)
-> Chain
     (Either Object Bytes)
     (Maybe
        ((Object, EvaluationState),
         Chain (Either Object Bytes) (Object, EvaluationState)))
forall log a. Chain log a -> Chain log (Maybe (a, Chain log a))
msplit (String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBuiltinFunChain String
funcName Object
obj ()) Chain
  (Either Object Bytes)
  (Maybe
     ((Object, EvaluationState),
      Chain (Either Object Bytes) (Object, EvaluationState)))
-> (Maybe
      ((Object, EvaluationState),
       Chain (Either Object Bytes) (Object, EvaluationState))
    -> Chain (Either Object Bytes) (Context, Either Object Bytes))
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
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
            Maybe
  ((Object, EvaluationState),
   Chain (Either Object Bytes) (Object, EvaluationState))
Nothing -> do
              Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
              (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject Object
obj)
            Just ((Object
obj', EvaluationState
_state), Chain (Either Object Bytes) (Object, EvaluationState)
_alts) -> do
              Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
              (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject Object
obj')
  | DataizeStepMode
DataizeAll <- DataizeStepMode
mode
  , Just (AlphaBinding' Attribute
Phi Object
decoratee) <- [Binding] -> Maybe Binding
forall a. [a] -> Maybe a
listToMaybe [Binding
b | b :: Binding
b@(AlphaBinding' Attribute
Phi Object
_) <- [Binding]
bs]
  , Bool -> Bool
not Bool
hasEmpty = do
      let decoratee' :: Object
decoratee' = Object -> Object -> Object
substThis Object
obj Object
decoratee
      String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataizing inside phi" (Object -> Either Object Bytes
AsObject Object
decoratee')
      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 = Phi}
      (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
extendedContext, Object -> Either Object Bytes
AsObject Object
decoratee')
  | Bool
otherwise = do
      String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"No change to formation" (Object -> Either Object Bytes
AsObject Object
obj)
      Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
      (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject Object
obj)
 where
  isEmpty :: Binding -> Bool
isEmpty (EmptyBinding Attribute
_) = Bool
True
  isEmpty Binding
DeltaEmptyBinding = Bool
True
  isEmpty Binding
_ = Bool
False
  hasEmpty :: Bool
hasEmpty = (Binding -> Bool) -> [Binding] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Binding -> Bool
isEmpty [Binding]
bs
-- IMPORTANT: dataize the object being copied IF normalization is stuck on it!
dataizeStepChain DataizeStepMode
_mode (Application Object
obj [Binding]
bindings) = Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall info a. Chain info a -> Chain info a
incLogLevel (Chain (Either Object Bytes) (Context, Either Object Bytes)
 -> Chain (Either Object Bytes) (Context, Either Object Bytes))
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ do
  String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataizing inside application" (Object -> Either Object Bytes
AsObject Object
obj)
  (Context -> Context)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall log a. (Context -> Context) -> Chain log a -> Chain log a
modifyContext (\Context
c -> Context
c{dataizePackage = False}) (Chain (Either Object Bytes) (Context, Either Object Bytes)
 -> Chain (Either Object Bytes) (Context, Either Object Bytes))
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ do
    (Context
ctx, Either Object Bytes
obj') <- DataizeStepMode
-> Object
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
dataizeStepChain DataizeStepMode
DataizeOnlyLambda Object
obj
    case Either Object Bytes
obj' of
      Left Object
obj'' -> (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject (Object
obj'' Object -> [Binding] -> Object
`Application` [Binding]
bindings))
      Right Bytes
bytes -> (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject ([Binding] -> Object
Formation [Bytes -> Binding
DeltaBinding Bytes
bytes] Object -> [Binding] -> Object
`Application` [Binding]
bindings))
-- IMPORTANT: dataize the object being dispatched IF normalization is stuck on it!
dataizeStepChain DataizeStepMode
_mode (ObjectDispatch Object
obj Attribute
attr) = Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall info a. Chain info a -> Chain info a
incLogLevel (Chain (Either Object Bytes) (Context, Either Object Bytes)
 -> Chain (Either Object Bytes) (Context, Either Object Bytes))
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ do
  String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataizing inside dispatch" (Object -> Either Object Bytes
AsObject Object
obj)
  (Context -> Context)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall log a. (Context -> Context) -> Chain log a -> Chain log a
modifyContext (\Context
c -> Context
c{dataizePackage = False}) (Chain (Either Object Bytes) (Context, Either Object Bytes)
 -> Chain (Either Object Bytes) (Context, Either Object Bytes))
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a b. (a -> b) -> a -> b
$ do
    (Context
ctx, Either Object Bytes
obj') <- DataizeStepMode
-> Object
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
dataizeStepChain DataizeStepMode
DataizeOnlyLambda Object
obj
    case Either Object Bytes
obj' of
      Left Object
obj'' -> (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject (Object
obj'' Object -> Attribute -> Object
`ObjectDispatch` Attribute
attr))
      Right Bytes
bytes -> (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject ([Binding] -> Object
Formation [Bytes -> Binding
DeltaBinding Bytes
bytes] Object -> Attribute -> Object
`ObjectDispatch` Attribute
attr))
dataizeStepChain DataizeStepMode
_mode Object
obj = do
  String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Nothing to dataize" (Object -> Either Object Bytes
AsObject Object
obj)
  Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
  (Context, Either Object Bytes)
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context
ctx, Object -> Either Object Bytes
AsObject Object
obj)

dataizeRecursivelyChain' :: Context -> Object -> ([LogEntry (Either Object Bytes)], Either Object Bytes)
dataizeRecursivelyChain' :: Context
-> Object
-> ([LogEntry (Either Object Bytes)], Either Object Bytes)
dataizeRecursivelyChain' Context
ctx Object
obj = [([LogEntry (Either Object Bytes)], Either Object Bytes)]
-> ([LogEntry (Either Object Bytes)], Either Object Bytes)
forall a. HasCallStack => [a] -> a
head (Chain (Either Object Bytes) (Either Object Bytes)
-> Context
-> [([LogEntry (Either Object Bytes)], Either Object Bytes)]
forall log result.
Chain log result -> Context -> [([LogEntry log], result)]
runChain (Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
False Object
obj) Context
ctx)

-- | Recursively perform normalization and dataization until we get bytes in the end,
-- reporting intermediate steps
dataizeRecursivelyChain :: Bool -> Object -> DataizeChain (Either Object Bytes)
dataizeRecursivelyChain :: Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain = (Chain (Either Object Bytes) (Either Object Bytes)
 -> Chain (Either Object Bytes) (Either Object Bytes))
-> (Object -> Chain (Either Object Bytes) (Either Object Bytes))
-> Object
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a b. (a -> b) -> (Object -> a) -> Object -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chain (Either Object Bytes) (Either Object Bytes)
-> Chain (Either Object Bytes) (Either Object Bytes)
minimizeObject' ((Object -> Chain (Either Object Bytes) (Either Object Bytes))
 -> Object -> Chain (Either Object Bytes) (Either Object Bytes))
-> (Bool
    -> Object -> Chain (Either Object Bytes) (Either Object Bytes))
-> Bool
-> Object
-> Chain (Either Object Bytes) (Either Object Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
go
 where
  go :: Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
go Bool
normalizeRequired Object
obj = do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataizing" (Object -> Either Object Bytes
AsObject Object
obj)
    Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
    let globalObject :: Object
globalObject = NonEmpty Object -> Object
forall a. NonEmpty a -> a
NonEmpty.last (Context -> NonEmpty Object
outerFormations Context
ctx)
    let limits :: ApplicationLimits
limits = Int -> ApplicationLimits
defaultApplicationLimits (Object -> Int
objectSize Object
globalObject)
    let normalizedObj :: Chain Object Object
normalizedObj
          | Context -> Bool
builtinRules Context
ctx = do
              let obj' :: Object
obj' = Context -> Object -> Object
fastYegorInsideOut Context
ctx Object
obj
              String -> Object -> Chain Object EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Normalized" Object
obj'
              Object -> Chain Object Object
forall a. a -> Chain Object a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
obj'
          | Bool
otherwise = ApplicationLimits -> Object -> Chain Object Object
applyRulesChainWith ApplicationLimits
limits Object
obj
    Chain (Either Object Bytes) Object
-> Chain
     (Either Object Bytes)
     (Maybe (Object, Chain (Either Object Bytes) Object))
forall log a. Chain log a -> Chain log (Maybe (a, Chain log a))
msplit (Chain Object Object -> Chain (Either Object Bytes) Object
forall a. NormalizeChain a -> DataizeChain a
transformNormLogs Chain Object Object
normalizedObj) Chain
  (Either Object Bytes)
  (Maybe (Object, Chain (Either Object Bytes) Object))
-> (Maybe (Object, Chain (Either Object Bytes) Object)
    -> Chain (Either Object Bytes) (Either Object Bytes))
-> Chain (Either Object Bytes) (Either Object Bytes)
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
      Maybe (Object, Chain (Either Object Bytes) Object)
Nothing -> do
        String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"No rules applied" (Object -> Either Object Bytes
AsObject Object
obj)
        Either Object Bytes
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Either Object Bytes
AsObject Object
obj)
      -- We trust that all chains lead to the same result due to confluence
      Just (Object
normObj, Chain (Either Object Bytes) Object
_alternatives)
        | Object
normObj Object -> Object -> Bool
forall a. Eq a => a -> a -> Bool
== Object
obj Bool -> Bool -> Bool
&& Bool
normalizeRequired -> Either Object Bytes
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Either Object Bytes
AsObject Object
obj)
        | Bool
otherwise -> do
            (Context
ctx', Either Object Bytes
step) <- DataizeStepMode
-> Object
-> Chain (Either Object Bytes) (Context, Either Object Bytes)
dataizeStepChain DataizeStepMode
DataizeAll Object
normObj
            case Either Object Bytes
step of
              (AsObject Object
stillObj)
                | Object
stillObj Object -> Object -> Bool
forall a. Eq a => a -> a -> Bool
== Object
normObj Bool -> Bool -> Bool
&& Context
ctx Context -> Context -> Bool
`sameContext` Context
ctx' -> do
                    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataization changed nothing" (Object -> Either Object Bytes
AsObject Object
stillObj)
                    Either Object Bytes
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return Either Object Bytes
step -- dataization changed nothing
                | Bool
otherwise -> do
                    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Dataization changed something" (Object -> Either Object Bytes
AsObject Object
stillObj)
                    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
ctx' (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)
go Bool
False Object
stillObj -- partially dataized
              Either Object Bytes
bytes -> Either Object Bytes
-> Chain (Either Object Bytes) (Either Object Bytes)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return Either Object Bytes
bytes

-- | Given converters between Bytes and some data type, a binary function on this data type, an object,
-- and the current state of evaluation, returns the new object and a possibly modified state along with intermediate steps.
evaluateDataizationFunChain ::
  -- | How to convert the result back to bytes
  (res -> Bytes) ->
  -- | How to interpret the bytes in terms of the given data type
  (Bytes -> a) ->
  -- | How to wrap the bytes in an object
  (Bytes -> Object) ->
  -- | A binary function on the data
  (a -> a -> res) ->
  Object ->
  EvaluationState ->
  DataizeChain (Object, EvaluationState)
evaluateDataizationFunChain :: forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (a -> a -> res)
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateDataizationFunChain res -> Bytes
resultToBytes Bytes -> a
bytesToParam Bytes -> Object
wrapBytes a -> a -> res
func Object
obj EvaluationState
_state = do
  let o_rho :: Object
o_rho = Object -> Attribute -> Object
ObjectDispatch Object
obj Attribute
Rho
  let o_a0 :: Object
o_a0 = Object -> Attribute -> Object
ObjectDispatch Object
obj (AlphaIndex -> Attribute
Alpha (String -> AlphaIndex
AlphaIndex String
"α0"))
  Either Object Bytes
lhs <- 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
$ do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluating LHS" (Object -> Either Object Bytes
AsObject Object
o_rho)
    Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True Object
o_rho
  Either Object Bytes
rhs <- 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
$ do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluating RHS" (Object -> Either Object Bytes
AsObject Object
o_a0)
    Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True Object
o_a0
  Object
result <- case (Either Object Bytes
lhs, Either Object Bytes
rhs) of
    (AsBytes Bytes
l, AsBytes Bytes
r) -> do
      let bytes :: Bytes
bytes = res -> Bytes
resultToBytes (Bytes -> a
bytesToParam Bytes
r a -> a -> res
`func` Bytes -> a
bytesToParam Bytes
l)
          resultObj :: Object
resultObj = Bytes -> Object
wrapBytes Bytes
bytes
      String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluated function" (Object -> Either Object Bytes
AsObject Object
resultObj)
      Object -> Chain (Either Object Bytes) Object
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
resultObj
    (Either Object Bytes, Either Object Bytes)
_ -> String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Couldn't find bytes in one or both of LHS and RHS"
  (Object, EvaluationState)
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object
result, ())

evaluateBinaryDataizationFunChain ::
  -- | How to convert the result back to bytes
  (res -> Bytes) ->
  -- | How to interpret the bytes in terms of the given data type
  (Bytes -> a) ->
  -- | How to wrap the bytes in an object
  (Bytes -> Object) ->
  -- | Extract the 1st argument to be dataized
  (Object -> Object) ->
  -- | Extract the 2nd argument to be dataized
  (Object -> Object) ->
  -- | A binary function on the argument
  (a -> a -> res) ->
  -- | Name of the atom.
  String ->
  Object ->
  EvaluationState ->
  DataizeChain (Object, EvaluationState)
evaluateBinaryDataizationFunChain :: forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBinaryDataizationFunChain res -> Bytes
resultToBytes Bytes -> a
bytesToParam Bytes -> Object
wrapBytes Object -> Object
arg1 Object -> Object
arg2 a -> a -> res
func String
name Object
obj EvaluationState
_state = do
  let lhsArg :: Object
lhsArg = Object -> Object
arg1 Object
obj
  let rhsArg :: Object
rhsArg = Object -> Object
arg2 Object
obj
  Either Object Bytes
lhs <- 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
$ do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluating LHS" (Object -> Either Object Bytes
AsObject Object
lhsArg)
    Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True Object
lhsArg
  Either Object Bytes
rhs <- 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
$ do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluating RHS" (Object -> Either Object Bytes
AsObject Object
rhsArg)
    Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True Object
rhsArg
  Object
result <- case (Either Object Bytes
lhs, Either Object Bytes
rhs) of
    (AsBytes Bytes
l, AsBytes Bytes
r) -> do
      let bytes :: Bytes
bytes = res -> Bytes
resultToBytes (Bytes -> a
bytesToParam Bytes
l a -> a -> res
`func` Bytes -> a
bytesToParam Bytes
r)
          resultObj :: Object
resultObj = Bytes -> Object
wrapBytes Bytes
bytes
      String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluated function" (Object -> Either Object Bytes
AsObject Object
resultObj)
      Object -> Chain (Either Object Bytes) Object
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
resultObj
    (AsObject Object
_l, AsObject Object
_r) ->
      String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Couldn't find bytes in both LHS and RHS")
    (AsObject Object
l, Either Object Bytes
_) -> do
      String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Couldn't find bytes in LHS: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. (Pretty a, SugarableFinally a) => a -> String
printTree (Object -> Object
hideRho Object
l))
    (Either Object Bytes
_, AsObject Object
r) -> do
      String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Couldn't find bytes in RHS: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. (Pretty a, SugarableFinally a) => a -> String
printTree (Object -> Object
hideRho Object
r))
  (Object, EvaluationState)
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object
result, ())

evaluatePartialBinaryDataizationFunChain ::
  -- | How to convert the result back to bytes
  (res -> Bytes) ->
  -- | How to interpret the bytes in terms of the given data type
  (Bytes -> a) ->
  -- | How to wrap the bytes in an object
  (Bytes -> Object) ->
  -- | Extract the 1st argument to be dataized
  (Object -> Object) ->
  -- | Extract the 2nd argument to be dataized
  (Object -> Object) ->
  -- | A binary function on the argument
  (a -> a -> Maybe res) ->
  -- | Name of the atom.
  String ->
  Object ->
  EvaluationState ->
  DataizeChain (Object, EvaluationState)
evaluatePartialBinaryDataizationFunChain :: forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> Maybe res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluatePartialBinaryDataizationFunChain res -> Bytes
resultToBytes Bytes -> a
bytesToParam Bytes -> Object
wrapBytes Object -> Object
arg1 Object -> Object
arg2 a -> a -> Maybe res
func String
name Object
obj EvaluationState
_state = do
  let lhsArg :: Object
lhsArg = Object -> Object
arg1 Object
obj
  let rhsArg :: Object
rhsArg = Object -> Object
arg2 Object
obj
  Either Object Bytes
lhs <- 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
$ do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluating LHS" (Object -> Either Object Bytes
AsObject Object
lhsArg)
    Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True Object
lhsArg
  Either Object Bytes
rhs <- 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
$ do
    String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluating RHS" (Object -> Either Object Bytes
AsObject Object
rhsArg)
    Bool -> Object -> Chain (Either Object Bytes) (Either Object Bytes)
dataizeRecursivelyChain Bool
True Object
rhsArg
  Object
result <- case (Either Object Bytes
lhs, Either Object Bytes
rhs) of
    (AsBytes Bytes
l, AsBytes Bytes
r) -> do
      case res -> Bytes
resultToBytes (res -> Bytes) -> Maybe res -> Maybe Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bytes -> a
bytesToParam Bytes
l a -> a -> Maybe res
`func` Bytes -> a
bytesToParam Bytes
r of
        Maybe Bytes
Nothing -> String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": throws an error")
        Just Bytes
bytes -> do
          let resultObj :: Object
resultObj = Bytes -> Object
wrapBytes Bytes
bytes
          String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep String
"Evaluated function" (Object -> Either Object Bytes
AsObject Object
resultObj)
          Object -> Chain (Either Object Bytes) Object
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
resultObj
    (AsObject Object
_l, AsObject Object
_r) ->
      String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Couldn't find bytes in both LHS and RHS")
    (AsObject Object
l, Either Object Bytes
_) -> do
      String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Couldn't find bytes in LHS: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. (Pretty a, SugarableFinally a) => a -> String
printTree (Object -> Object
hideRho Object
l))
    (Either Object Bytes
_, AsObject Object
r) -> do
      String -> Chain (Either Object Bytes) Object
forall a. String -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Couldn't find bytes in RHS: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. (Pretty a, SugarableFinally a) => a -> String
printTree (Object -> Object
hideRho Object
r))
  (Object, EvaluationState)
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object
result, ())

-- | Unary functions operate on the given object without any additional parameters
evaluateUnaryDataizationFunChain ::
  -- | How to convert the result back to bytes
  (res -> Bytes) ->
  -- | How to interpret the bytes in terms of the given data type
  (Bytes -> a) ->
  -- | How to wrap the bytes in an object
  (Bytes -> Object) ->
  -- | Extract the argument to be dataized
  (Object -> Object) ->
  -- | A unary function on the argument
  (a -> res) ->
  String ->
  Object ->
  EvaluationState ->
  DataizeChain (Object, EvaluationState)
evaluateUnaryDataizationFunChain :: forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateUnaryDataizationFunChain res -> Bytes
resultToBytes Bytes -> a
bytesToParam Bytes -> Object
wrapBytes Object -> Object
extractArg a -> res
func =
  (res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBinaryDataizationFunChain res -> Bytes
resultToBytes Bytes -> a
bytesToParam Bytes -> Object
wrapBytes Object -> Object
extractArg Object -> Object
extractArg (res -> a -> res
forall a b. a -> b -> a
const (res -> a -> res) -> (a -> res) -> a -> a -> res
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> res
func)

-- This should maybe get converted to a type class and some instances?
evaluateIntIntIntFunChain :: (Int -> Int -> Int) -> String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateIntIntIntFunChain :: (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateIntIntIntFunChain = (Int -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBinaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x")

evaluateIntIntMaybeIntFunChain :: (Int -> Int -> Maybe Int) -> String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateIntIntMaybeIntFunChain :: (Int -> Int -> Maybe Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateIntIntMaybeIntFunChain = (Int -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> Maybe Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> Maybe res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluatePartialBinaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesInConstInt Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x")

evaluateIntIntBoolFunChain :: (Int -> Int -> Bool) -> String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateIntIntBoolFunChain :: (Int -> Int -> Bool)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateIntIntBoolFunChain = (Bool -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> Bool)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBinaryDataizationFunChain Bool -> Bytes
boolToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesAsBool Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x")

-- Int because Bytes are just a string, but Int has a Bits instance
evaluateBytesBytesBytesFunChain :: (Int -> Int -> Int) -> String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateBytesBytesBytesFunChain :: (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBytesBytesBytesFunChain = (Int -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Int -> Int -> Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBinaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"b")

evaluateBytesBytesFunChain :: (Int -> Int) -> String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateBytesBytesFunChain :: (Int -> Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBytesBytesFunChain = (Int -> Bytes)
-> (Bytes -> Int)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Int -> Int)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateUnaryDataizationFunChain Int -> Bytes
intToBytes Bytes -> Int
bytesToInt Bytes -> Object
wrapBytesInBytes Object -> Object
extractRho

evaluateFloatFloatFloatFunChain :: (Double -> Double -> Double) -> String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateFloatFloatFloatFunChain :: (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateFloatFloatFloatFunChain = (Double -> Bytes)
-> (Bytes -> Double)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (Double -> Double -> Double)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall res a.
(res -> Bytes)
-> (Bytes -> a)
-> (Bytes -> Object)
-> (Object -> Object)
-> (Object -> Object)
-> (a -> a -> res)
-> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBinaryDataizationFunChain Double -> Bytes
floatToBytes Bytes -> Double
bytesToFloat Bytes -> Object
wrapBytesInConstFloat Object -> Object
extractRho (String -> Object -> Object
extractLabel String
"x")

-- | Like `evaluateDataizationFunChain` but specifically for the built-in functions.
-- This function is not safe. It returns undefined for unknown functions
evaluateBuiltinFunChain :: String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateBuiltinFunChain :: String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBuiltinFunChain String
name Object
obj EvaluationState
state = do
  Context
ctx <- Chain (Either Object Bytes) Context
forall a. Chain a Context
getContext
  case String
-> HashMap
     String
     (String
      -> Object
      -> EvaluationState
      -> Chain (Either Object Bytes) (Object, EvaluationState))
-> Maybe
     (String
      -> Object
      -> EvaluationState
      -> Chain (Either Object Bytes) (Object, EvaluationState))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup String
name Context
ctx.knownAtoms of
    Just String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
f -> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
f String
name Object
obj EvaluationState
state
    Maybe
  (String
   -> Object
   -> EvaluationState
   -> Chain (Either Object Bytes) (Object, EvaluationState))
Nothing -> String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBuiltinFunChainUnknown String
name Object
obj EvaluationState
state

evaluateBuiltinFunChainUnknown :: String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateBuiltinFunChainUnknown :: String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBuiltinFunChainUnknown String
atomName Object
obj EvaluationState
state = do
  String
-> Either Object Bytes
-> Chain (Either Object Bytes) EvaluationState
forall info. String -> info -> Chain info EvaluationState
logStep [fmt|[INFO]: unknown atom ({atomName})|] (Object -> Either Object Bytes
AsObject Object
obj)
  (Object, EvaluationState)
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object
obj, EvaluationState
state)

-- | Like `evaluateDataizationFun` but specifically for the built-in functions.
-- This function is not safe. It returns undefined for unknown functions
evaluateBuiltinFun :: Context -> String -> Object -> EvaluationState -> (Object, EvaluationState)
evaluateBuiltinFun :: Context
-> String -> Object -> EvaluationState -> (Object, EvaluationState)
evaluateBuiltinFun Context
ctx String
name Object
obj EvaluationState
state = ([LogEntry (Either Object Bytes)], (Object, EvaluationState))
-> (Object, EvaluationState)
forall a b. (a, b) -> b
snd (([LogEntry (Either Object Bytes)], (Object, EvaluationState))
 -> (Object, EvaluationState))
-> ([LogEntry (Either Object Bytes)], (Object, EvaluationState))
-> (Object, EvaluationState)
forall a b. (a -> b) -> a -> b
$ [([LogEntry (Either Object Bytes)], (Object, EvaluationState))]
-> ([LogEntry (Either Object Bytes)], (Object, EvaluationState))
forall a. HasCallStack => [a] -> a
head ([([LogEntry (Either Object Bytes)], (Object, EvaluationState))]
 -> ([LogEntry (Either Object Bytes)], (Object, EvaluationState)))
-> [([LogEntry (Either Object Bytes)], (Object, EvaluationState))]
-> ([LogEntry (Either Object Bytes)], (Object, EvaluationState))
forall a b. (a -> b) -> a -> b
$ Chain (Either Object Bytes) (Object, EvaluationState)
-> Context
-> [([LogEntry (Either Object Bytes)], (Object, EvaluationState))]
forall log result.
Chain log result -> Context -> [([LogEntry log], result)]
runChain (String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateBuiltinFunChain String
name Object
obj EvaluationState
state) Context
ctx -- FIXME: head is bad

evaluateIODataizationFunChain :: IO String -> Object -> EvaluationState -> DataizeChain (Object, EvaluationState)
evaluateIODataizationFunChain :: IO String
-> Object
-> EvaluationState
-> Chain (Either Object Bytes) (Object, EvaluationState)
evaluateIODataizationFunChain IO String
action Object
_obj EvaluationState
state =
  (Object, EvaluationState)
-> Chain (Either Object Bytes) (Object, EvaluationState)
forall a. a -> Chain (Either Object Bytes) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding] -> Object
Formation [Bytes -> Binding
DeltaBinding (String -> Bytes
stringToBytes (IO String -> String
forall a. IO a -> a
unsafePerformIO IO String
action))], EvaluationState
state)

extractRho :: Object -> Object
extractRho :: Object -> Object
extractRho = (Object -> Attribute -> Object
`ObjectDispatch` Attribute
Rho)
extractAlpha0 :: Object -> Object
extractAlpha0 :: Object -> Object
extractAlpha0 = (Object -> Attribute -> Object
`ObjectDispatch` AlphaIndex -> Attribute
Alpha (String -> AlphaIndex
AlphaIndex String
"α0"))
extractLabel :: String -> Object -> Object
extractLabel :: String -> Object -> Object
extractLabel String
attrName = (Object -> Attribute -> Object
`ObjectDispatch` LabelId -> Attribute
Label (String -> LabelId
LabelId String
attrName))