Use T.Text instead of String
This commit is contained in:
parent
b20bbb732e
commit
2803808116
2 changed files with 15 additions and 9 deletions
|
|
@ -1,11 +1,14 @@
|
||||||
module Propa.Prolog.Types
|
module Propa.Prolog.Types
|
||||||
( Term(..)
|
( Term(..)
|
||||||
, Def(..)
|
, Def(..)
|
||||||
|
, Db
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
data Term a
|
data Term a
|
||||||
= Var a
|
= Var a
|
||||||
| Stat String [Term a]
|
| Stat T.Text [Term a]
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance Functor Term where
|
instance Functor Term where
|
||||||
|
|
@ -20,7 +23,7 @@ instance Traversable Term where
|
||||||
traverse f (Var a) = Var <$> f a
|
traverse f (Var a) = Var <$> f a
|
||||||
traverse f (Stat name args) = Stat name <$> traverse (traverse f) args
|
traverse f (Stat name args) = Stat name <$> traverse (traverse f) args
|
||||||
|
|
||||||
data Def a = Def String [Term a] [Term a]
|
data Def a = Def T.Text [Term a] [Term a]
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance Functor Def where
|
instance Functor Def where
|
||||||
|
|
@ -34,3 +37,5 @@ instance Traversable Def where
|
||||||
= Def dName
|
= Def dName
|
||||||
<$> traverse (traverse f) dArgs
|
<$> traverse (traverse f) dArgs
|
||||||
<*> traverse (traverse f) dTerms
|
<*> traverse (traverse f) dTerms
|
||||||
|
|
||||||
|
type Db a = [Def a]
|
||||||
|
|
|
||||||
|
|
@ -12,23 +12,24 @@ import Control.Monad.Trans.Class
|
||||||
import Control.Monad.Trans.State
|
import Control.Monad.Trans.State
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Propa.Prolog.Types
|
import Propa.Prolog.Types
|
||||||
|
|
||||||
data Context = Context
|
data Context = Context
|
||||||
{ cDb :: [Def String]
|
{ cDb :: Db T.Text
|
||||||
, cVarIdx :: Int
|
, cVarIdx :: Int
|
||||||
, cVars :: Map.Map Int Int
|
, cVars :: Map.Map Int Int
|
||||||
, cTerms :: Map.Map Int (String, [Term Int])
|
, cTerms :: Map.Map Int (T.Text, [Term Int])
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
newContext :: [Def String] -> Context
|
newContext :: [Def T.Text] -> Context
|
||||||
newContext db = Context db 0 Map.empty Map.empty
|
newContext db = Context db 0 Map.empty Map.empty
|
||||||
|
|
||||||
learnVar :: Int -> Int -> UniM ()
|
learnVar :: Int -> Int -> UniM ()
|
||||||
learnVar k v = modify $ \c -> c{cVars = Map.insert k v $ cVars c}
|
learnVar k v = modify $ \c -> c{cVars = Map.insert k v $ cVars c}
|
||||||
|
|
||||||
learnTerm :: Int -> String -> [Term Int] -> UniM ()
|
learnTerm :: Int -> T.Text -> [Term Int] -> UniM ()
|
||||||
learnTerm k name args = modify $ \c -> c{cTerms = Map.insert k (name, args) $ cTerms c}
|
learnTerm k name args = modify $ \c -> c{cTerms = Map.insert k (name, args) $ cTerms c}
|
||||||
|
|
||||||
-- | Look up a variable, first in the var map and then the term map. Returns
|
-- | Look up a variable, first in the var map and then the term map. Returns
|
||||||
|
|
@ -53,7 +54,7 @@ type UniM = StateT Context []
|
||||||
fastNub :: (Ord a) => [a] -> [a]
|
fastNub :: (Ord a) => [a] -> [a]
|
||||||
fastNub = Set.toList . Set.fromList
|
fastNub = Set.toList . Set.fromList
|
||||||
|
|
||||||
varMap :: (Foldable a) => a String -> UniM (Map.Map String Int)
|
varMap :: (Foldable a) => a T.Text -> UniM (Map.Map T.Text Int)
|
||||||
varMap a = do
|
varMap a = do
|
||||||
c <- get
|
c <- get
|
||||||
let i = cVarIdx c
|
let i = cVarIdx c
|
||||||
|
|
@ -64,7 +65,7 @@ varMap a = do
|
||||||
|
|
||||||
-- | Convert a definition's variables to unique integers that are not already in
|
-- | Convert a definition's variables to unique integers that are not already in
|
||||||
-- use in the current context.
|
-- use in the current context.
|
||||||
understand :: (Functor a, Foldable a) => a String -> UniM (a Int, Map.Map String Int)
|
understand :: (Functor a, Foldable a) => a T.Text -> UniM (a Int, Map.Map T.Text Int)
|
||||||
understand a = do
|
understand a = do
|
||||||
vmap <- varMap a
|
vmap <- varMap a
|
||||||
pure (fmap (vmap Map.!) a, vmap)
|
pure (fmap (vmap Map.!) a, vmap)
|
||||||
|
|
@ -98,7 +99,7 @@ unifyTerms t1 t2 = do
|
||||||
lift $ guard $ length t1 == length t2
|
lift $ guard $ length t1 == length t2
|
||||||
sequenceA_ $ zipWith unify t1 t2
|
sequenceA_ $ zipWith unify t1 t2
|
||||||
|
|
||||||
run :: Term String -> UniM (Map.Map String (Term Int))
|
run :: Term T.Text -> UniM (Map.Map T.Text (Term Int))
|
||||||
run t = do
|
run t = do
|
||||||
(t2, vmap) <- understand t
|
(t2, vmap) <- understand t
|
||||||
satisfy t2
|
satisfy t2
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue