{-# LANGUAGE BangPatterns, DataKinds, ScopedTypeVariables, KindSignatures #-}
module Math.Singular.Factory.Variables where
import Data.Char
import Data.List ( findIndex )
import Text.Read
import Data.Proxy
import GHC.TypeLits
import System.IO.Unsafe as Unsafe
import Math.Singular.Factory.Internal.CanonicalForm
type VarIdx = Int
theFactoryVars :: [Var]
theFactoryVars = map mk [1..] where
mk i = Unsafe.unsafePerformIO $ newVarL i
theNthVar :: VarIdx -> Var
theNthVar idx = theFactoryVars !! (idx-1)
class VariableSet v where
varIdxName :: Proxy v -> VarIdx -> String
recogVarName :: Proxy v -> String -> Maybe VarIdx
data VarN (s :: Symbol)
data Var_N (s :: Symbol)
data VarBracketN (s :: Symbol)
data VarAbc
data VarABC
data VarXyz
data VarXYZ
instance forall s. KnownSymbol s => VariableSet (VarN s) where
varIdxName _ = indexedVars (symbolVal (Proxy :: Proxy s))
recogVarName _ = recogIndexed (symbolVal (Proxy :: Proxy s))
instance forall s. KnownSymbol s => VariableSet (Var_N s) where
varIdxName _ = indexedVarsUnderscore (symbolVal (Proxy :: Proxy s))
recogVarName _ = recogIndexedUnderscore (symbolVal (Proxy :: Proxy s))
instance forall s. KnownSymbol s => VariableSet (VarBracketN s) where
varIdxName _ = indexedVarsBracket (symbolVal (Proxy :: Proxy s))
recogVarName _ = recogIndexedBracket (symbolVal (Proxy :: Proxy s))
instance VariableSet VarAbc where
varIdxName _ = abcVars
recogVarName _ = recogAbc
instance VariableSet VarABC where
varIdxName _ = capitalAbcVars
recogVarName _ = recogABC
instance VariableSet VarXyz where
varIdxName _ = xyzVars
recogVarName _ = recogXyz
instance VariableSet VarXYZ where
varIdxName _ = capitalXyzVars
recogVarName _ = recogXYZ
indexedVars :: String -> VarIdx -> String
indexedVars prefix = \i -> prefix ++ show i
indexedVarsUnderscore :: String -> VarIdx -> String
indexedVarsUnderscore prefix = \i -> prefix ++ "_" ++ show i
indexedVarsBracket :: String -> VarIdx -> String
indexedVarsBracket prefix = \i -> prefix ++ "[" ++ show i ++ "]"
abcVars :: VarIdx -> String
abcVars idx = lowerVarList !! (idx-1)
capitalAbcVars :: VarIdx -> String
capitalAbcVars idx = lowerVarList !! (idx-1)
xyzVars :: VarIdx -> String
xyzVars idx = [ varListXyz !! (idx-1) ]
capitalXyzVars :: VarIdx -> String
capitalXyzVars idx = [ varListCapitalXYZ !! (idx-1) ]
varListXyz :: [Char]
varListXyz = "xyzuvwabcdefghijklmnopqrst"
varListCapitalXYZ :: [Char]
varListCapitalXYZ = "XYZUVWABCDEFGHIJKLMNOPQRST"
lowerVarList :: [String]
lowerVarList = map (:[]) abc ++ [ ys ++ [y] | ys<-lowerVarList , y<-abc ] where
abc = ['a'..'z']
upperVarList :: [String]
upperVarList = map (:[]) abc ++ [ ys ++ [y] | ys<-lowerVarList , y<-abc ] where
abc = ['A'..'Z']
readPosIdxMaybe :: String -> Maybe VarIdx
readPosIdxMaybe s = case readMaybe s :: Maybe Word of
Nothing -> Nothing
Just w -> let j = (fromIntegral w :: Int)
in if j >= 1 then Just j else Nothing
recogIndexed :: String -> String -> Maybe VarIdx
recogIndexed !prefix = recog where
!n = length prefix
recog s = case splitAt n s of
(p,q) -> if p /= prefix
then Nothing
else readPosIdxMaybe q
recogIndexedUnderscore :: String -> String -> Maybe VarIdx
recogIndexedUnderscore !prefix = recog where
!n = length prefix
recog s = case splitAt n s of
(p,q) -> if p /= prefix
then Nothing
else case q of
('_':r ) -> readPosIdxMaybe r
_ -> Nothing
recogIndexedBracket :: String -> String -> Maybe VarIdx
recogIndexedBracket !prefix = recog where
!n = length prefix
recog s = case splitAt n s of
(p,q) -> if p /= prefix
then Nothing
else if length q >= 3 && head q == '[' && last q == ']'
then readPosIdxMaybe (init $ tail q)
else Nothing
recogAbc :: String -> Maybe VarIdx
recogAbc [c] = if c >= 'a' && c <= 'z' then Just (ord c - 96) else Nothing
recogAbc [] = Nothing
recogAbc _ = Nothing
recogABC :: String -> Maybe VarIdx
recogABC [c] = if c >= 'A' && c <= 'Z' then Just (ord c - 64) else Nothing
recogABC [] = Nothing
recogABC _ = Nothing
recogXyz :: String -> Maybe VarIdx
recogXyz [c] = if c >= 'a' && c <= 'z' then (+1) <$> findIndex (==c) varListXyz else Nothing
recogXyz _ = Nothing
recogXYZ :: String -> Maybe VarIdx
recogXYZ [c] = if c >= 'A' && c <= 'Z' then (+1) <$> findIndex (==c) varListCapitalXYZ else Nothing
recogXYZ _ = Nothing