content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Jikka.RestrictedPython.Language.Value where
  
  import Data.Char (toLower)
  import Data.List (intercalate)
  import qualified Data.Map.Strict as M
  import Data.Maybe (fromMaybe)
  import qualified Data.Vector as V
  import Jikka.Common.Error
  import Jikka.Common.IOFormat
  import Jikka.Common.Matrix
  import Jikka.RestrictedPython.Language.Expr
  
  -- | `Value` is the values of our restricted Python-like language.
  --
  -- \[
  --     \begin{array}{rl}
  --         v ::= & \dots, -2, -1, 0, 1, 2, \dots \\
  --         \vert & \mathbf{false}, \mathbf{true} \\
  --         \vert & \mathbf{nil} \\
  --         \vert & \mathbf{cons}(v, v) \\
  --         \vert & (v, v, \dots, v) \\
  --         \vert & \lambda _ \mu x x \dots x. e \\
  --         \vert & \mathrm{builtin} \\
  --     \end{array}
  -- \]
  data Value
    = IntVal Integer
    | BoolVal Bool
    | ListVal (V.Vector Value)
    | TupleVal [Value]
    | ClosureVal Local [(VarName, Type)] [Statement]
    | BuiltinVal Builtin
    | AttributeVal Value Attribute
    deriving (Eq, Ord, Show, Read)
  
  newtype Local = Local
    { unLocal :: M.Map VarName Value
    }
    deriving (Eq, Ord, Show, Read)
  
  toInt :: MonadError Error m => Value -> m Integer
  toInt = \case
    IntVal n -> return n
    v -> throwInternalError $ "not an integer value: " ++ formatValue v
  
  toBool :: MonadError Error m => Value -> m Bool
  toBool = \case
    BoolVal p -> return p
    v -> throwInternalError $ "not a boolean value: " ++ formatValue v
  
  toList :: MonadError Error m => Value -> m (V.Vector Value)
  toList = \case
    ListVal xs -> return xs
    v -> throwInternalError $ "not a list value: " ++ formatValue v
  
  toTuple :: MonadError Error m => Value -> m [Value]
  toTuple = \case
    TupleVal xs -> return xs
    v -> throwInternalError $ "not a tuple value: " ++ formatValue v
  
  toIntList :: MonadError Error m => Value -> m (V.Vector Integer)
  toIntList xs = V.mapM toInt =<< toList xs
  
  toBoolList :: MonadError Error m => Value -> m (V.Vector Bool)
  toBoolList xs = V.mapM toBool =<< toList xs
  
  toMatrix :: MonadError Error m => Value -> m (Matrix Integer)
  toMatrix a = toMatrix' =<< V.mapM toIntList =<< toList a
    where
      toMatrix' a = case makeMatrix a of
        Just a -> return a
        Nothing -> throwInternalError $ "not a matrix: " ++ show a
  
  fromMatrix :: Matrix Integer -> Value
  fromMatrix a = ListVal (fmap (ListVal . fmap IntVal) (unMatrix a))
  
  compareValues :: Value -> Value -> Maybe Ordering
  compareValues a b = case (a, b) of
    (IntVal a, IntVal b) -> Just $ compare a b
    (BoolVal a, BoolVal b) -> Just $ compare a b
    (ListVal a, ListVal b) -> case mconcat (V.toList (V.zipWith compareValues a b)) of
      Nothing -> Nothing
      Just EQ -> Just $ compare (V.length a) (V.length b)
      Just o -> Just o
    (TupleVal a, TupleVal b) ->
      if length a /= length b
        then Nothing
        else mconcat (zipWith compareValues a b)
    (_, _) -> Nothing
  
  compareValues' :: Value -> Value -> Ordering
  compareValues' a b = fromMaybe EQ (compareValues a b)
  
  formatValue :: Value -> String
  formatValue = \case
    IntVal n -> show n
    BoolVal p -> map toLower (show p)
    ListVal xs -> "[" ++ intercalate ", " (map formatValue (V.toList xs)) ++ "]"
    TupleVal [x] -> "(" ++ formatValue x ++ ",)"
    TupleVal xs -> "(" ++ intercalate ", " (map formatValue xs) ++ ")"
    f@ClosureVal {} -> show f
    BuiltinVal b -> show b
    AttributeVal x a -> "(" ++ formatValue x ++ ")." ++ show a
  
  readValueIO :: (MonadIO m, MonadError Error m) => IOFormat -> m ([Value], M.Map String Value)
  readValueIO = makeReadValueIO toInt IntVal toList ListVal
  
  writeValueIO :: (MonadError Error m, MonadIO m) => IOFormat -> M.Map String Value -> Value -> m ()
  writeValueIO = makeWriteValueIO toTuple IntVal toInt toList
  