never executed always true always false
    1 {-|
    2 Module: Flaw.Script.Lua
    3 Description: Lua implementation in Haskell.
    4 License: MIT
    5 -}
    6 
    7 {-# LANGUAGE GADTs #-}
    8 
    9 module Flaw.Script.Lua
   10   ( LuaMonad(..)
   11   , LuaValue(..)
   12   , LuaError(..)
   13   , LuaLoadError(..)
   14   ) where
   15 
   16 import Control.Exception
   17 import Control.Monad.Fail
   18 import Control.Monad.Primitive
   19 import Data.Hashable
   20 import qualified Data.HashTable.ST.Cuckoo as HT
   21 import Data.Primitive.MutVar
   22 import qualified Data.Text as T
   23 import Data.Typeable
   24 import Data.Unique
   25 import Data.Word
   26 
   27 class (PrimMonad m, MonadFail m) => LuaMonad m where
   28   newLuaUnique :: m Unique
   29   throwLuaError :: LuaError m -> m a
   30   catchLuaError :: m a -> (LuaError m -> m a) -> m a
   31 
   32 instance LuaMonad IO where
   33   newLuaUnique = newUnique
   34   throwLuaError = throwIO
   35   catchLuaError = catch
   36 
   37 -- | Lua value.
   38 data LuaValue m where
   39   -- Standard 'nil' value.
   40   LuaNil :: LuaValue m
   41   -- Standard boolean value.
   42   LuaBoolean :: {-# UNPACK #-} !Word8 -> LuaValue m
   43   -- Integer 'number' value.
   44   LuaInteger :: {-# UNPACK #-} !Int -> LuaValue m
   45   -- Real 'number' value.
   46   LuaReal :: {-# UNPACK #-} !Double -> LuaValue m
   47   -- String value.
   48   LuaString :: {-# UNPACK #-} !T.Text -> LuaValue m
   49   -- Lua function
   50   LuaClosure ::
   51     { luaClosureUnique :: !Unique
   52     , luaClosure :: !([LuaValue m] -> m [LuaValue m])
   53     } -> LuaValue m
   54   -- User data.
   55   LuaUserData ::
   56     { luaUserDataUnique :: !Unique
   57     , luaUserData :: !a
   58     } -> LuaValue m
   59   LuaTable ::
   60     { luaTableUnique :: !Unique
   61     , luaTable :: {-# UNPACK #-} !(HT.HashTable (PrimState m) (LuaValue m) (LuaValue m))
   62     , luaTableLength :: {-# UNPACK #-} !(MutVar (PrimState m) Int)
   63     , luaTableMetaTable :: {-# UNPACK #-} !(MutVar (PrimState m) (LuaValue m))
   64     } -> LuaValue m
   65 
   66 instance Eq (LuaValue m) where
   67   {-# INLINABLE (==) #-}
   68   LuaNil == LuaNil = True
   69   LuaBoolean a == LuaBoolean b = a == b
   70   LuaInteger a == LuaInteger b = a == b
   71   LuaReal a == LuaReal b = a == b
   72   LuaString a == LuaString b = a == b
   73   LuaClosure { luaClosureUnique = a } == LuaClosure { luaClosureUnique = b } = a == b
   74   LuaUserData { luaUserDataUnique = a } == LuaUserData { luaUserDataUnique = b } = a == b
   75   LuaTable { luaTableUnique = a } == LuaTable { luaTableUnique = b } = a == b
   76   _ == _ = False
   77 
   78 instance Hashable (LuaValue m) where
   79   {-# INLINABLE hashWithSalt #-}
   80   hashWithSalt s v = case v of
   81     LuaNil -> s `hashWithSalt` (0 :: Int)
   82     LuaBoolean b -> s `hashWithSalt` (1 :: Int) `hashWithSalt` b
   83     LuaInteger i -> s `hashWithSalt` (2 :: Int) `hashWithSalt` i
   84     LuaReal r -> s `hashWithSalt` (3 :: Int) `hashWithSalt` r
   85     LuaString t -> s `hashWithSalt` (4 :: Int) `hashWithSalt` t
   86     LuaClosure
   87       { luaClosureUnique = u
   88       } -> s `hashWithSalt` (5 :: Int) `hashWithSalt` hashUnique u
   89     LuaUserData
   90       { luaUserDataUnique = u
   91       } -> s `hashWithSalt` (6 :: Int) `hashWithSalt` hashUnique u
   92     LuaTable
   93       { luaTableUnique = u
   94       } -> s `hashWithSalt` (7 :: Int) `hashWithSalt` hashUnique u
   95 
   96 instance Show (LuaValue m) where
   97   showsPrec p v q = case v of
   98     LuaNil -> "LuaNil" ++ q
   99     LuaBoolean b -> enclose $ \qq -> "LuaBoolean " ++ showsPrec 10 b qq
  100     LuaInteger i -> enclose $ \qq -> "LuaInteger " ++ showsPrec 10 i qq
  101     LuaReal r -> enclose $ \qq -> "LuaReal " ++ showsPrec 10 r qq
  102     LuaString t -> enclose $ \qq -> "LuaString " ++ showsPrec 10 t qq
  103     LuaClosure
  104       { luaClosureUnique = u
  105       } -> enclose $ \qq -> "LuaClosure { luaClosureUnique = " ++ shows (hashUnique u) qq
  106     LuaUserData
  107       { luaUserDataUnique = u
  108       } -> enclose $ \qq -> "LuaUserData { luaUserDataUnique = " ++ shows (hashUnique u) qq
  109     LuaTable
  110       { luaTableUnique = u
  111       } -> enclose $ \qq -> "LuaTable { luaTableUnique = " ++ shows (hashUnique u) qq
  112     where enclose f = if p >= 10 then '(' : f (')' : q) else f q
  113 
  114 data LuaError m
  115   -- | Standard Lua error (e.g. thrown by 'error' stdlib function).
  116   = LuaError !(LuaValue m)
  117   -- | Operation is called on unsupported value, and value
  118   -- doesn't have metatable, or doesn't have specific metamethod.
  119   | LuaBadOperation !T.Text
  120   deriving Show
  121 
  122 instance Typeable m => Exception (LuaError m)
  123 
  124 -- | Error while loading Lua chunk.
  125 data LuaLoadError
  126   = LuaLoadError !T.Text
  127   deriving Show
  128 
  129 instance Exception LuaLoadError