{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- Allow us to use string literals to represent Text.
{-# LANGUAGE OverloadedStrings #-}

-- Allow the use of \case
{-# LANGUAGE LambdaCase #-}

module Graphics.Implicit.ExtOpenScad.Default (defaultObjects) where

-- be explicit about where we pull things in from.
import Prelude (Bool(True, False), Maybe(Just, Nothing), ($), (<>), (<$>), fmap, pi, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, abs, signum, fromInteger, (.), floor, ceiling, round, exp, log, sqrt, max, min, atan2, (**), flip, (<), (>), (<=), (>=), (==), (/=), (&&), (||), not, show, foldl, (*), (/), mod, (+), zipWith, (-), otherwise, id, foldMap, fromIntegral)

import Graphics.Implicit.Definitions (ℝ, ℕ)

import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup(VarLookup), OVal(OBool, OList, ONum, OString, OUndefined, OError, OFunc, OVargsModule), Symbol(Symbol), StateC, StatementI, SourcePosition, MessageType(TextOut, Warning), ScadOpts(ScadOpts))

import Graphics.Implicit.ExtOpenScad.Util.OVal (toOObj, oTypeStr)

import Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules)

import Graphics.Implicit.ExtOpenScad.Util.StateC (scadOptions, modifyVarLookup, addMessage)

import Data.Int (Int64)

import Data.Map (Map, fromList, insert)

import Data.List (genericIndex, genericLength)

import Data.Foldable (for_)

import qualified Data.Text.Lazy as TL (index)

import Data.Text.Lazy (Text, intercalate, unpack, pack, length, singleton)

defaultObjects :: Bool -> VarLookup
defaultObjects :: Bool -> VarLookup
defaultObjects Bool
withCSG = Map Symbol OVal -> VarLookup
VarLookup (Map Symbol OVal -> VarLookup) -> Map Symbol OVal -> VarLookup
forall a b. (a -> b) -> a -> b
$ [(Symbol, OVal)] -> Map Symbol OVal
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Symbol, OVal)] -> Map Symbol OVal)
-> [(Symbol, OVal)] -> Map Symbol OVal
forall a b. (a -> b) -> a -> b
$
    [(Symbol, OVal)]
defaultConstants
    [(Symbol, OVal)] -> [(Symbol, OVal)] -> [(Symbol, OVal)]
forall a. Semigroup a => a -> a -> a
<> [(Symbol, OVal)]
defaultFunctions
    [(Symbol, OVal)] -> [(Symbol, OVal)] -> [(Symbol, OVal)]
forall a. Semigroup a => a -> a -> a
<> [(Symbol, OVal)]
defaultFunctions2
    [(Symbol, OVal)] -> [(Symbol, OVal)] -> [(Symbol, OVal)]
forall a. Semigroup a => a -> a -> a
<> [(Symbol, OVal)]
defaultFunctionsSpecial
    [(Symbol, OVal)] -> [(Symbol, OVal)] -> [(Symbol, OVal)]
forall a. Semigroup a => a -> a -> a
<> [(Symbol, OVal)]
defaultPolymorphicFunctions
    [(Symbol, OVal)] -> [(Symbol, OVal)] -> [(Symbol, OVal)]
forall a. Semigroup a => a -> a -> a
<> (if Bool
withCSG then [(Symbol, OVal)]
primitiveModules else [])
    [(Symbol, OVal)] -> [(Symbol, OVal)] -> [(Symbol, OVal)]
forall a. Semigroup a => a -> a -> a
<> [(Symbol, OVal)]
varArgModules

-- FIXME: Missing standard ones(which standard?):
-- rand, lookup,

defaultConstants :: [(Symbol, OVal)]
defaultConstants :: [(Symbol, OVal)]
defaultConstants = (\(Symbol
a,ℝ
b) -> (Symbol
a, ℝ -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (ℝ
b :: ℝ))) ((Symbol, ℝ) -> (Symbol, OVal))
-> [(Symbol, ℝ)] -> [(Symbol, OVal)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [(Text -> Symbol
Symbol Text
"pi", ℝ
forall a. Floating a => a
pi),
     (Text -> Symbol
Symbol Text
"PI", ℝ
forall a. Floating a => a
pi)]

defaultFunctions :: [(Symbol, OVal)]
defaultFunctions :: [(Symbol, OVal)]
defaultFunctions = (\(Symbol
a,ℝ -> ℝ
b) -> (Symbol
a, (ℝ -> ℝ) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj ( ℝ -> ℝ
b :: ℝ -> ℝ))) ((Symbol, ℝ -> ℝ) -> (Symbol, OVal))
-> [(Symbol, ℝ -> ℝ)] -> [(Symbol, OVal)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [
        (Text -> Symbol
Symbol Text
"sin",   ℝ -> ℝ
forall a. Floating a => a -> a
sin),
        (Text -> Symbol
Symbol Text
"cos",   ℝ -> ℝ
forall a. Floating a => a -> a
cos),
        (Text -> Symbol
Symbol Text
"tan",   ℝ -> ℝ
forall a. Floating a => a -> a
tan),
        (Text -> Symbol
Symbol Text
"asin",  ℝ -> ℝ
forall a. Floating a => a -> a
asin),
        (Text -> Symbol
Symbol Text
"acos",  ℝ -> ℝ
forall a. Floating a => a -> a
acos),
        (Text -> Symbol
Symbol Text
"atan",  ℝ -> ℝ
forall a. Floating a => a -> a
atan),
        (Text -> Symbol
Symbol Text
"sinh",  ℝ -> ℝ
forall a. Floating a => a -> a
sinh),
        (Text -> Symbol
Symbol Text
"cosh",  ℝ -> ℝ
forall a. Floating a => a -> a
cosh),
        (Text -> Symbol
Symbol Text
"tanh",  ℝ -> ℝ
forall a. Floating a => a -> a
tanh),
        (Text -> Symbol
Symbol Text
"abs",   ℝ -> ℝ
forall a. Num a => a -> a
abs),
        (Text -> Symbol
Symbol Text
"sign",  ℝ -> ℝ
forall a. Num a => a -> a
signum),
        (Text -> Symbol
Symbol Text
"floor", Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> ℝ) -> (ℝ -> Integer) -> ℝ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ),
        (Text -> Symbol
Symbol Text
"ceil",  Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> ℝ) -> (ℝ -> Integer) -> ℝ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ),
        (Text -> Symbol
Symbol Text
"round", Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> ℝ) -> (ℝ -> Integer) -> ℝ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round ),
        (Text -> Symbol
Symbol Text
"exp",   ℝ -> ℝ
forall a. Floating a => a -> a
exp),
        (Text -> Symbol
Symbol Text
"ln",    ℝ -> ℝ
forall a. Floating a => a -> a
log),
        (Text -> Symbol
Symbol Text
"log",   ℝ -> ℝ
forall a. Floating a => a -> a
log),
        (Text -> Symbol
Symbol Text
"sign",  ℝ -> ℝ
forall a. Num a => a -> a
signum),
        (Text -> Symbol
Symbol Text
"sqrt",  ℝ -> ℝ
forall a. Floating a => a -> a
sqrt)
    ]

defaultFunctions2 :: [(Symbol, OVal)]
defaultFunctions2 :: [(Symbol, OVal)]
defaultFunctions2 = (\(Symbol
a,ℝ -> ℝ -> ℝ
b) -> (Symbol
a, (ℝ -> ℝ -> ℝ) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (ℝ -> ℝ -> ℝ
b :: ℝ -> ℝ -> ℝ))) ((Symbol, ℝ -> ℝ -> ℝ) -> (Symbol, OVal))
-> [(Symbol, ℝ -> ℝ -> ℝ)] -> [(Symbol, OVal)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [
        (Text -> Symbol
Symbol Text
"max",   ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
max),
        (Text -> Symbol
Symbol Text
"min",   ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
min),
        (Text -> Symbol
Symbol Text
"atan2", ℝ -> ℝ -> ℝ
forall a. RealFloat a => a -> a -> a
atan2),
        (Text -> Symbol
Symbol Text
"pow",   ℝ -> ℝ -> ℝ
forall a. Floating a => a -> a -> a
(**))
    ]

defaultFunctionsSpecial :: [(Symbol, OVal)]
defaultFunctionsSpecial :: [(Symbol, OVal)]
defaultFunctionsSpecial =
    [
        (Text -> Symbol
Symbol Text
"map", ([OVal] -> (OVal -> OVal) -> [OVal]) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (([OVal] -> (OVal -> OVal) -> [OVal]) -> OVal)
-> ([OVal] -> (OVal -> OVal) -> [OVal]) -> OVal
forall a b. (a -> b) -> a -> b
$ ((OVal -> OVal) -> [OVal] -> [OVal])
-> [OVal] -> (OVal -> OVal) -> [OVal]
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            ((OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap :: (OVal -> OVal) -> [OVal] -> [OVal] )
        )
    ]

varArgModules :: [(Symbol, OVal)]
varArgModules :: [(Symbol, OVal)]
varArgModules =
    [
        Text
-> (Symbol
    -> SourcePosition
    -> [(Maybe Symbol, OVal)]
    -> [StatementI]
    -> ([StatementI] -> StateC ())
    -> StateC ())
-> (Symbol, OVal)
modVal Text
"echo" Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
echo
       ,Text
-> (Symbol
    -> SourcePosition
    -> [(Maybe Symbol, OVal)]
    -> [StatementI]
    -> ([StatementI] -> StateC ())
    -> StateC ())
-> (Symbol, OVal)
modVal Text
"for" Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
for
       ,Text
-> (Symbol
    -> SourcePosition
    -> [(Maybe Symbol, OVal)]
    -> [StatementI]
    -> ([StatementI] -> StateC ())
    -> StateC ())
-> (Symbol, OVal)
modVal Text
"color" Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
executeSuite
    ] where
        modVal :: Text
-> (Symbol
    -> SourcePosition
    -> [(Maybe Symbol, OVal)]
    -> [StatementI]
    -> ([StatementI] -> StateC ())
    -> StateC ())
-> (Symbol, OVal)
modVal Text
name Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
func = (Text -> Symbol
Symbol Text
name, Symbol
-> (Symbol
    -> SourcePosition
    -> [(Maybe Symbol, OVal)]
    -> [StatementI]
    -> ([StatementI] -> StateC ())
    -> StateC ())
-> OVal
OVargsModule (Text -> Symbol
Symbol Text
name) Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
func)

        -- execute only the child statement, without doing anything else. Useful for unimplemented functions.
        executeSuite :: Symbol -> SourcePosition -> [(Maybe Symbol, OVal)] -> [StatementI] -> ([StatementI] -> StateC ()) -> StateC ()
        executeSuite :: Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
executeSuite (Symbol Text
name) SourcePosition
pos [(Maybe Symbol, OVal)]
_ [StatementI]
suite [StatementI] -> StateC ()
runSuite = do
            MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
Warning SourcePosition
pos (Text -> StateC ()) -> Text -> StateC ()
forall a b. (a -> b) -> a -> b
$ Text
"Module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not implemented"
            [StatementI] -> StateC ()
runSuite [StatementI]
suite

        echo :: Symbol -> SourcePosition -> [(Maybe Symbol, OVal)] -> [StatementI] -> ([StatementI] -> StateC ()) -> StateC ()
        echo :: Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
echo Symbol
_ SourcePosition
pos [(Maybe Symbol, OVal)]
args [StatementI]
suite [StatementI] -> StateC ()
runSuite = do
            ScadOpts
scadOpts <- StateC ScadOpts
scadOptions
            let
                text :: [(Maybe Symbol, OVal)] -> Text
                text :: [(Maybe Symbol, OVal)] -> Text
text [(Maybe Symbol, OVal)]
a = Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Maybe Symbol, OVal) -> Text
show' ((Maybe Symbol, OVal) -> Text) -> [(Maybe Symbol, OVal)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Symbol, OVal)]
a
                show' :: (Maybe Symbol, OVal) -> Text
                show' :: (Maybe Symbol, OVal) -> Text
show' (Maybe Symbol
Nothing, OVal
arg) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OVal -> String
forall a. Show a => a -> String
show OVal
arg
                show' (Just (Symbol Text
var), OVal
arg) = Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (OVal -> String
forall a. Show a => a -> String
show OVal
arg)
                showe' :: (Maybe Symbol, OVal) -> Text
                showe' :: (Maybe Symbol, OVal) -> Text
showe' (Maybe Symbol
Nothing, OString Text
arg) = Text
arg
                showe' (Just (Symbol Text
var), OVal
arg) = Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Maybe Symbol, OVal) -> Text
showe' (Maybe Symbol
forall a. Maybe a
Nothing, OVal
arg)
                showe' (Maybe Symbol, OVal)
a = (Maybe Symbol, OVal) -> Text
show' (Maybe Symbol, OVal)
a
                compat :: ScadOpts -> Bool
compat (ScadOpts Bool
compat_flag Bool
_) = Bool
compat_flag
                openScadFormat :: Text
openScadFormat = Text
"ECHO: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Maybe Symbol, OVal)] -> Text
text [(Maybe Symbol, OVal)]
args
                extopenscadFormat :: Text
extopenscadFormat = ((Maybe Symbol, OVal) -> Text) -> [(Maybe Symbol, OVal)] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Symbol, OVal) -> Text
showe' [(Maybe Symbol, OVal)]
args
                formattedMessage :: Text
formattedMessage = if ScadOpts -> Bool
compat ScadOpts
scadOpts then Text
openScadFormat else Text
extopenscadFormat
            MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
TextOut SourcePosition
pos Text
formattedMessage
            [StatementI] -> StateC ()
runSuite [StatementI]
suite

        for :: Symbol -> SourcePosition -> [(Maybe Symbol, OVal)] -> [StatementI] -> ([StatementI] -> StateC ()) -> StateC ()
        for :: Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
for Symbol
_ SourcePosition
_ [(Maybe Symbol, OVal)]
args [StatementI]
suite [StatementI] -> StateC ()
runSuite =
            [VarLookup -> VarLookup]
-> ((VarLookup -> VarLookup) -> StateC ()) -> StateC ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([(Maybe Symbol, OVal)] -> [VarLookup -> VarLookup]
iterator [(Maybe Symbol, OVal)]
args) (((VarLookup -> VarLookup) -> StateC ()) -> StateC ())
-> ((VarLookup -> VarLookup) -> StateC ()) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \VarLookup -> VarLookup
iter -> do
                (VarLookup -> VarLookup) -> StateC ()
modifyVarLookup VarLookup -> VarLookup
iter
                [StatementI] -> StateC ()
runSuite [StatementI]
suite
          where
            -- convert a list of arguments into a list of functions to transform the VarLookup with new bindings for each possible iteration.
            iterator :: [(Maybe Symbol, OVal)] -> [VarLookup -> VarLookup]
            iterator :: [(Maybe Symbol, OVal)] -> [VarLookup -> VarLookup]
iterator [] = [VarLookup -> VarLookup
forall a. a -> a
id]
            iterator ((Maybe Symbol
Nothing, OVal
_):[(Maybe Symbol, OVal)]
iterators) = [(Maybe Symbol, OVal)] -> [VarLookup -> VarLookup]
iterator [(Maybe Symbol, OVal)]
iterators
            iterator ((Just Symbol
var, OVal
vals):[(Maybe Symbol, OVal)]
iterators) = [VarLookup -> VarLookup
outer (VarLookup -> VarLookup)
-> (VarLookup -> VarLookup) -> VarLookup -> VarLookup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Symbol OVal -> Map Symbol OVal) -> VarLookup -> VarLookup
varify Map Symbol OVal -> Map Symbol OVal
inner | Map Symbol OVal -> Map Symbol OVal
inner <- Symbol -> OVal -> Map Symbol OVal -> Map Symbol OVal
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Symbol
var (OVal -> Map Symbol OVal -> Map Symbol OVal)
-> [OVal] -> [Map Symbol OVal -> Map Symbol OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OVal -> [OVal]
valsList OVal
vals, VarLookup -> VarLookup
outer <- [(Maybe Symbol, OVal)] -> [VarLookup -> VarLookup]
iterator [(Maybe Symbol, OVal)]
iterators]
            -- convert the loop iterator variable's expression value to a list (possibly of one value)
            valsList :: OVal -> [OVal]
            valsList :: OVal -> [OVal]
valsList v :: OVal
v@(OBool Bool
_) = [OVal
v]
            valsList v :: OVal
v@(ONum ℝ
_) = [OVal
v]
            valsList v :: OVal
v@(OString Text
_) = [OVal
v]
            valsList (OList [OVal]
vs) = [OVal]
vs
            valsList OVal
_ = []
            -- promote a result into a VarLookup
            varify :: (Map Symbol OVal -> Map Symbol OVal) -> VarLookup -> VarLookup
            varify :: (Map Symbol OVal -> Map Symbol OVal) -> VarLookup -> VarLookup
varify Map Symbol OVal -> Map Symbol OVal
f (VarLookup Map Symbol OVal
v) = Map Symbol OVal -> VarLookup
VarLookup (Map Symbol OVal -> VarLookup) -> Map Symbol OVal -> VarLookup
forall a b. (a -> b) -> a -> b
$ Map Symbol OVal -> Map Symbol OVal
f Map Symbol OVal
v

-- | more complicated ones:
defaultPolymorphicFunctions :: [(Symbol, OVal)]
defaultPolymorphicFunctions :: [(Symbol, OVal)]
defaultPolymorphicFunctions =
    [
        (Text -> Symbol
Symbol Text
"+", (OVal -> OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal -> OVal
add),
        (Text -> Symbol
Symbol Text
"sum", OVal
sumtotal),
        (Text -> Symbol
Symbol Text
"*", OVal
prod),
        (Text -> Symbol
Symbol Text
"prod", OVal
prod),
        (Text -> Symbol
Symbol Text
"/", OVal
divide),
        (Text -> Symbol
Symbol Text
"-", (OVal -> OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal -> OVal
sub),
        (Text -> Symbol
Symbol Text
"%", (OVal -> OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal -> OVal
omod),
        (Text -> Symbol
Symbol Text
"^", (ℝ -> ℝ -> ℝ) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (ℝ -> ℝ -> ℝ
forall a. Floating a => a -> a -> a
(**) :: ℝ -> ℝ -> ℝ)),
        (Text -> Symbol
Symbol Text
"negate", (OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal
negatefun),
        (Text -> Symbol
Symbol Text
"index", (OVal -> OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal -> OVal
index),
        (Text -> Symbol
Symbol Text
"splice", (OVal -> OVal -> OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal -> OVal -> OVal
osplice),
        (Text -> Symbol
Symbol Text
"<", (ℝ -> ℝ -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj  (ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
(<) :: ℝ -> ℝ -> Bool) ),
        (Text -> Symbol
Symbol Text
">", (ℝ -> ℝ -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj  (ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
(>) :: ℝ -> ℝ -> Bool) ),
        (Text -> Symbol
Symbol Text
">=", (ℝ -> ℝ -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
(>=) :: ℝ -> ℝ -> Bool) ),
        (Text -> Symbol
Symbol Text
"<=", (ℝ -> ℝ -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
(<=) :: ℝ -> ℝ -> Bool) ),
        (Text -> Symbol
Symbol Text
"==", (OVal -> OVal -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (OVal -> OVal -> Bool
forall a. Eq a => a -> a -> Bool
(==) :: OVal -> OVal -> Bool) ),
        (Text -> Symbol
Symbol Text
"!=", (OVal -> OVal -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (OVal -> OVal -> Bool
forall a. Eq a => a -> a -> Bool
(/=) :: OVal -> OVal -> Bool) ),
        (Text -> Symbol
Symbol Text
"?", (Bool -> OVal -> OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj ( Bool -> OVal -> OVal -> OVal
forall t. Bool -> t -> t -> t
ternary :: Bool -> OVal -> OVal -> OVal) ),
        (Text -> Symbol
Symbol Text
"&&", (Bool -> Bool -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj Bool -> Bool -> Bool
(&&) ),
        (Text -> Symbol
Symbol Text
"||", (Bool -> Bool -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj Bool -> Bool -> Bool
(||) ),
        (Text -> Symbol
Symbol Text
"!", (Bool -> Bool) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj Bool -> Bool
not ),
        (Text -> Symbol
Symbol Text
"list_gen", ([ℝ] -> Maybe [ℝ]) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj [ℝ] -> Maybe [ℝ]
list_gen),
        (Text -> Symbol
Symbol Text
"<>", OVal
concatenate),
        (Text -> Symbol
Symbol Text
"len", (OVal -> OVal) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj OVal -> OVal
olength),
        (Text -> Symbol
Symbol Text
"str", (OVal -> Text) -> OVal
forall a. OTypeMirror a => a -> OVal
toOObj (String -> Text
pack(String -> Text) -> (OVal -> String) -> OVal -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.OVal -> String
forall a. Show a => a -> String
show :: OVal -> Text))
    ] where

        -- Some key functions are written as OVals in optimizations attempts

        prod :: OVal
prod = (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
            (OList (OVal
y:[OVal]
ys)) -> (OVal -> OVal -> OVal) -> OVal -> [OVal] -> OVal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OVal -> OVal -> OVal
mult OVal
y [OVal]
ys
            (OList [])     -> ℝ -> OVal
ONum ℝ
1
            (ONum ℝ
a)       -> (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
                (OList []) -> ℝ -> OVal
ONum ℝ
a
                (OList [OVal]
n)  -> OVal -> OVal -> OVal
mult (ℝ -> OVal
ONum ℝ
a) ([OVal] -> OVal
OList [OVal]
n)
                (ONum ℝ
b)   -> OVal -> OVal -> OVal
mult (ℝ -> OVal
ONum ℝ
a) (ℝ -> OVal
ONum ℝ
b)
                OVal
_          -> Text -> OVal
OError Text
"prod takes only lists or nums"
            OVal
_              -> Text -> OVal
OError Text
"prod takes only lists or nums"

        mult :: OVal -> OVal -> OVal
mult (ONum ℝ
a)  (ONum ℝ
b)  = ℝ -> OVal
ONum  (ℝ
aℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
b)
        mult (ONum ℝ
a)  (OList [OVal]
b) = [OVal] -> OVal
OList ((OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OVal -> OVal -> OVal
mult (ℝ -> OVal
ONum ℝ
a)) [OVal]
b)
        mult (OList [OVal]
a) (ONum ℝ
b)  = [OVal] -> OVal
OList ((OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OVal -> OVal -> OVal
mult (ℝ -> OVal
ONum ℝ
b)) [OVal]
a)
        mult (OList [OVal]
a) (OList [OVal]
b) = [OVal] -> OVal
OList ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ (OVal -> OVal -> OVal) -> [OVal] -> [OVal] -> [OVal]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OVal -> OVal -> OVal
mult [OVal]
a [OVal]
b
        mult OVal
a         OVal
b         = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"product" OVal
a OVal
b

        divide :: OVal
divide = (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
            (ONum ℝ
a) -> (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
                (ONum ℝ
b) -> ℝ -> OVal
ONum (ℝ
aℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
b)
                OVal
b        -> Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"divide" (ℝ -> OVal
ONum ℝ
a) OVal
b
            OVal
a -> (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
                OVal
b -> OVal -> OVal -> OVal
div' OVal
a OVal
b

        div' :: OVal -> OVal -> OVal
div' (ONum ℝ
a)  (ONum ℝ
b) = ℝ -> OVal
ONum  (ℝ
aℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
b)
        div' (OList [OVal]
a) (ONum ℝ
b) = [OVal] -> OVal
OList ((OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\OVal
x -> OVal -> OVal -> OVal
div' OVal
x (ℝ -> OVal
ONum ℝ
b)) [OVal]
a)
        div' OVal
a         OVal
b        = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"divide" OVal
a OVal
b

        omod :: OVal -> OVal -> OVal
omod (ONum ℝ
a) (ONum ℝ
b) = ℝ -> OVal
ONum (ℝ -> OVal) -> (Integer -> ℝ) -> Integer -> OVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> OVal) -> Integer -> OVal
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
a) (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
b)
        omod OVal
a        OVal
b        = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"mod" OVal
a OVal
b

        concatenate :: OVal
concatenate = (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
            (OList (OVal
y:[OVal]
ys)) -> (OVal -> OVal -> OVal) -> OVal -> [OVal] -> OVal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OVal -> OVal -> OVal
append OVal
y [OVal]
ys
            (OList [])     -> [OVal] -> OVal
OList []
            OVal
_              -> Text -> OVal
OError Text
"concat takes a list"

        append :: OVal -> OVal -> OVal
append (OList   [OVal]
a) (OList   [OVal]
b) = [OVal] -> OVal
OList   ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ [OVal]
a[OVal] -> [OVal] -> [OVal]
forall a. Semigroup a => a -> a -> a
<>[OVal]
b
        append (OString Text
a) (OString Text
b) = Text -> OVal
OString (Text -> OVal) -> Text -> OVal
forall a b. (a -> b) -> a -> b
$ Text
aText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
b
        append OVal
a           OVal
b           = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"concat" OVal
a OVal
b

        sumtotal :: OVal
sumtotal = (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
            (OList (OVal
y:[OVal]
ys)) -> (OVal -> OVal -> OVal) -> OVal -> [OVal] -> OVal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OVal -> OVal -> OVal
add OVal
y [OVal]
ys
            (OList [])     -> ℝ -> OVal
ONum ℝ
0
            (ONum ℝ
a)       -> (OVal -> OVal) -> OVal
OFunc ((OVal -> OVal) -> OVal) -> (OVal -> OVal) -> OVal
forall a b. (a -> b) -> a -> b
$ \case
                (OList []) -> ℝ -> OVal
ONum ℝ
a
                (OList [OVal]
n)  -> OVal -> OVal -> OVal
add (ℝ -> OVal
ONum ℝ
a) ([OVal] -> OVal
OList [OVal]
n)
                (ONum ℝ
b)   -> OVal -> OVal -> OVal
add (ℝ -> OVal
ONum ℝ
a) (ℝ -> OVal
ONum ℝ
b)
                OVal
_          -> Text -> OVal
OError Text
"sum takes two lists or nums"
            OVal
_              -> Text -> OVal
OError Text
"sum takes two lists or nums"

        add :: OVal -> OVal -> OVal
add (ONum ℝ
a) (ONum ℝ
b) = ℝ -> OVal
ONum (ℝ
aℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
b)
        add (ONum ℝ
a)  (OList [OVal]
b) = [OVal] -> OVal
OList ((OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OVal -> OVal -> OVal
add (ℝ -> OVal
ONum ℝ
a)) [OVal]
b)
        add (OList [OVal]
a) (ONum ℝ
b)  = [OVal] -> OVal
OList ((OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OVal -> OVal -> OVal
add (ℝ -> OVal
ONum ℝ
b)) [OVal]
a)
        add (OList [OVal]
a) (OList [OVal]
b) = [OVal] -> OVal
OList ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ (OVal -> OVal -> OVal) -> [OVal] -> [OVal] -> [OVal]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OVal -> OVal -> OVal
add [OVal]
a [OVal]
b
        add OVal
a OVal
b = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"add" OVal
a OVal
b

        sub :: OVal -> OVal -> OVal
sub (ONum ℝ
a) (ONum ℝ
b) = ℝ -> OVal
ONum (ℝ
aℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
b)
        sub (OList [OVal]
a) (OList [OVal]
b) = [OVal] -> OVal
OList ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ (OVal -> OVal -> OVal) -> [OVal] -> [OVal] -> [OVal]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OVal -> OVal -> OVal
sub [OVal]
a [OVal]
b
        sub OVal
a OVal
b = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"subtract" OVal
a OVal
b

        negatefun :: OVal -> OVal
negatefun (ONum ℝ
n) = ℝ -> OVal
ONum (-ℝ
n)
        negatefun (OList [OVal]
l) = [OVal] -> OVal
OList ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ OVal -> OVal
negatefun (OVal -> OVal) -> [OVal] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OVal]
l
        negatefun OVal
a = Text -> OVal
OError (Text -> OVal) -> Text -> OVal
forall a b. (a -> b) -> a -> b
$ Text
"Can't negate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OVal -> Text
oTypeStr OVal
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (OVal -> String
forall a. Show a => a -> String
show OVal
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

        index :: OVal -> OVal -> OVal
index (OList [OVal]
l) (ONum ℝ
ind) =
            let
                n :: ℕ
                n :: ℕ
n = ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
ind
            in
              if ℕ
n ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
< [OVal] -> ℕ
forall i a. Num i => [a] -> i
genericLength [OVal]
l then [OVal]
l [OVal] -> ℕ -> OVal
forall i a. Integral i => [a] -> i -> a
`genericIndex` ℕ
n else Text -> OVal
OError Text
"List accessed out of bounds"
        index (OString Text
s) (ONum ℝ
ind) =
            let
                n :: Int64
                n :: Int64
n = ℝ -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
ind
            in if Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int64
length Text
s then Text -> OVal
OString (Char -> Text
singleton (Text -> Int64 -> Char
TL.index Text
s Int64
n)) else Text -> OVal
OError Text
"List accessed out of bounds"
        index OVal
a OVal
b = Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
"index" OVal
a OVal
b

        osplice :: OVal -> OVal -> OVal -> OVal
osplice (OList  [OVal]
list) (ONum ℝ
a) (    ONum ℝ
b    ) =
            [OVal] -> OVal
OList   ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ [OVal] -> ℕ -> ℕ -> [OVal]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [OVal]
list (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
a) (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
b)
        osplice (OString Text
str) (ONum ℝ
a) (    ONum ℝ
b    ) =
            Text -> OVal
OString (Text -> OVal) -> (String -> Text) -> String -> OVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> OVal) -> String -> OVal
forall a b. (a -> b) -> a -> b
$ String -> ℕ -> ℕ -> String
forall a. [a] -> ℕ -> ℕ -> [a]
splice (Text -> String
unpack Text
str)  (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
a) (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
b)
        osplice (OList  [OVal]
list)  OVal
OUndefined  (ONum ℝ
b    ) =
            [OVal] -> OVal
OList   ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ [OVal] -> ℕ -> ℕ -> [OVal]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [OVal]
list ℕ
0 (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
b)
        osplice (OString Text
str)  OVal
OUndefined  (ONum ℝ
b    ) =
            Text -> OVal
OString (Text -> OVal) -> (String -> Text) -> String -> OVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> OVal) -> String -> OVal
forall a b. (a -> b) -> a -> b
$ String -> ℕ -> ℕ -> String
forall a. [a] -> ℕ -> ℕ -> [a]
splice (Text -> String
unpack Text
str)  ℕ
0 (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
b)
        osplice (OList  [OVal]
list) (ONum ℝ
a)      OVal
OUndefined  =
            [OVal] -> OVal
OList   ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ [OVal] -> ℕ -> ℕ -> [OVal]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [OVal]
list (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
a) ([OVal] -> ℕ
forall i a. Num i => [a] -> i
genericLength [OVal]
list ℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
+ ℕ
1)
        osplice (OString Text
str) (ONum ℝ
a)      OVal
OUndefined  =
            Text -> OVal
OString (Text -> OVal) -> (String -> Text) -> String -> OVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> OVal) -> String -> OVal
forall a b. (a -> b) -> a -> b
$ String -> ℕ -> ℕ -> String
forall a. [a] -> ℕ -> ℕ -> [a]
splice (Text -> String
unpack Text
str)  (ℝ -> ℕ
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
a) (Int64 -> ℕ
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ℕ) -> Int64 -> ℕ
forall a b. (a -> b) -> a -> b
$ Text -> Int64
length Text
str  Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)
        osplice (OList  [OVal]
list)  OVal
OUndefined   OVal
OUndefined  =
            [OVal] -> OVal
OList   ([OVal] -> OVal) -> [OVal] -> OVal
forall a b. (a -> b) -> a -> b
$ [OVal] -> ℕ -> ℕ -> [OVal]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [OVal]
list ℕ
0 ([OVal] -> ℕ
forall i a. Num i => [a] -> i
genericLength [OVal]
list ℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
+ ℕ
1)
        osplice (OString Text
str)  OVal
OUndefined   OVal
OUndefined =
            Text -> OVal
OString (Text -> OVal) -> (String -> Text) -> String -> OVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> OVal) -> String -> OVal
forall a b. (a -> b) -> a -> b
$ String -> ℕ -> ℕ -> String
forall a. [a] -> ℕ -> ℕ -> [a]
splice (Text -> String
unpack Text
str)  ℕ
0 (Int64 -> ℕ
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ℕ) -> Int64 -> ℕ
forall a b. (a -> b) -> a -> b
$ Text -> Int64
length Text
str  Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)
        osplice OVal
_ OVal
_ OVal
_ = OVal
OUndefined

        splice :: [a] -> ℕ -> ℕ -> [a]
        splice :: [a] -> ℕ -> ℕ -> [a]
splice [] ℕ
_ ℕ
_     = []
        splice l :: [a]
l@(a
x:[a]
xs) ℕ
a ℕ
b
            |    ℕ
a ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
< ℕ
0  =    [a] -> ℕ -> ℕ -> [a]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [a]
l   (ℕ
aℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
+ℕ
n)  ℕ
b
            |    ℕ
b ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
< ℕ
0  =    [a] -> ℕ -> ℕ -> [a]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [a]
l    ℕ
a    (ℕ
bℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
+ℕ
n)
            |    ℕ
a ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
> ℕ
0  =    [a] -> ℕ -> ℕ -> [a]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [a]
xs  (ℕ
aℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
-ℕ
1) (ℕ
bℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
-ℕ
1)
            |    ℕ
b ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
> ℕ
0  = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> ℕ -> ℕ -> [a]
forall a. [a] -> ℕ -> ℕ -> [a]
splice [a]
xs   ℕ
a    (ℕ
bℕ -> ℕ -> ℕ
forall a. Num a => a -> a -> a
-ℕ
1)
            | Bool
otherwise = []
                    where
                      n :: ℕ
                      n :: ℕ
n = [a] -> ℕ
forall i a. Num i => [a] -> i
genericLength [a]
l

        errorAsAppropriate :: Text -> OVal -> OVal -> OVal
errorAsAppropriate Text
_   err :: OVal
err@(OError Text
_)   OVal
_ = OVal
err
        errorAsAppropriate Text
_   OVal
_   err :: OVal
err@(OError Text
_) = OVal
err
        errorAsAppropriate Text
name OVal
a OVal
b = Text -> OVal
OError (Text -> OVal) -> Text -> OVal
forall a b. (a -> b) -> a -> b
$
          Text
"Can't " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" objects of types " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OVal -> Text
oTypeStr OVal
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OVal -> Text
oTypeStr OVal
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

        list_gen :: [ℝ] -> Maybe [ℝ]
        list_gen :: [ℝ] -> Maybe [ℝ]
list_gen [ℝ
a, ℝ
b] = [ℝ] -> Maybe [ℝ]
forall a. a -> Maybe a
Just ([ℝ] -> Maybe [ℝ]) -> [ℝ] -> Maybe [ℝ]
forall a b. (a -> b) -> a -> b
$ Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> ℝ) -> [Integer] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ℝ
a).. (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
b)]
        list_gen [ℝ
a, ℝ
b, ℝ
c] =
            let
                nr :: ℝ
nr = (ℝ
cℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
a)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
b
                n :: ℝ
                n :: ℝ
n  = Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
nr)
            in if ℝ
nr ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
n ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0
            then [ℝ] -> Maybe [ℝ]
forall a. a -> Maybe a
Just ([ℝ] -> Maybe [ℝ]) -> [ℝ] -> Maybe [ℝ]
forall a b. (a -> b) -> a -> b
$ Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> ℝ) -> [Integer] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ℝ
a), (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (ℝ
aℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
b)).. (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (ℝ
c ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
bℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*(ℝ
nr ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
n)))]
            else [ℝ] -> Maybe [ℝ]
forall a. a -> Maybe a
Just ([ℝ] -> Maybe [ℝ]) -> [ℝ] -> Maybe [ℝ]
forall a b. (a -> b) -> a -> b
$ Integer -> ℝ
forall a. Num a => Integer -> a
fromInteger (Integer -> ℝ) -> [Integer] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ℝ
a), (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (ℝ
aℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
b)).. (ℝ -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
c)]
        list_gen [ℝ]
_ = Maybe [ℝ]
forall a. Maybe a
Nothing

        ternary :: Bool -> t -> t -> t
        ternary :: Bool -> t -> t -> t
ternary Bool
True t
a t
_ = t
a
        ternary Bool
False t
_ t
b = t
b

        olength :: OVal -> OVal
olength (OString Text
s) = ℝ -> OVal
ONum (ℝ -> OVal) -> ℝ -> OVal
forall a b. (a -> b) -> a -> b
$ Int64 -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ℝ) -> Int64 -> ℝ
forall a b. (a -> b) -> a -> b
$ Text -> Int64
length Text
s
        olength (OList [OVal]
s)   = ℝ -> OVal
ONum (ℝ -> OVal) -> ℝ -> OVal
forall a b. (a -> b) -> a -> b
$ [OVal] -> ℝ
forall i a. Num i => [a] -> i
genericLength [OVal]
s
        olength OVal
a           = Text -> OVal
OError (Text -> OVal) -> Text -> OVal
forall a b. (a -> b) -> a -> b
$ Text
"Can't take length of a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OVal -> Text
oTypeStr OVal
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."