Add integers

src/Propa/Prolog/Display.hs

@@ -45,6 +45,7 @@ displayList t                           = "|" <> displayTerm t <> "]"
 
 displayTerm :: Term T.Text -> T.Text
 displayTerm (TVar v)  = v
+displayTerm (TInt i)  = T.pack $ show i
 displayTerm (TStat s) = displayStat s
 
 displayTerms :: [Term T.Text] -> T.Text

src/Propa/Prolog/Parse.hs

@@ -54,7 +54,8 @@ pTermToStat :: Parser (Term T.Text) -> Parser (Stat T.Text)
 pTermToStat p = do
   term <- p
   case term of
-    (TVar _)  -> fail "expected term, not variable"
+    (TVar _)  -> fail "expected statement, not variable"
+    (TInt _)  -> fail "expected statement, not integer"
     (TStat s) -> pure s
 
 -- | Parse a statement of the form @name(args)@.
@@ -88,6 +89,7 @@ pList = do
 pPlainTerm :: Parser (Term T.Text)
 pPlainTerm
   =   (TVar <$> pVarName)
+  <|> (TInt <$> L.signed (pure ()) L.decimal)
   <|> (TStat <$> pPlainStat)
   <|> try pCons
   <|> pList

src/Propa/Prolog/Types.hs

@@ -1,6 +1,7 @@
 module Propa.Prolog.Types
   ( Stat(..)
   , Term(..)
+  , tVar
   , Def(..)
   , Db
   ) where
@@ -21,21 +22,29 @@ instance Traversable Stat where
 
 data Term a
   = TVar a
+  | TInt Integer
   | TStat (Stat a)
   deriving (Show, Eq)
 
 instance Functor Term where
   fmap f (TVar a)  = TVar $ f a
+  fmap _ (TInt i)  = TInt i
   fmap f (TStat s) = TStat $ fmap f s
 
 instance Foldable Term where
   foldMap f (TVar a)  = f a
+  foldMap _ (TInt _)  = mempty
   foldMap f (TStat s) = foldMap f s
 
 instance Traversable Term where
   traverse f (TVar a)  = TVar <$> f a
+  traverse _ (TInt i)  = pure $ TInt i
   traverse f (TStat s) = TStat <$> traverse f s
 
+tVar :: Term a -> Maybe a
+tVar (TVar v) = Just v
+tVar _        = Nothing
+
 data Def a = Def (Stat a) [Stat a]
   deriving (Show)
 

src/Propa/Prolog/Unify.hs

@@ -4,6 +4,7 @@ module Propa.Prolog.Unify
   ( run
   ) where
 
+import           Control.Applicative
 import           Control.Monad
 import           Data.Foldable
 import           Data.List
@@ -21,8 +22,8 @@ import           Propa.Prolog.Types
 
 -- | Start at a value and follow the map's entries until the end of the chain of
 -- references.
-follow :: (Ord a) => Map.Map a a -> a -> a
+follow :: (Ord a) => (b -> Maybe a) -> Map.Map a b -> b -> b
-follow m v = maybe v (follow m) $ m Map.!? v
+follow f m b = maybe b (follow f m) $ (m Map.!?) =<< f b
 
 -- | Deduplicates the elements of a finite list. Doesn't preserve the order of
 -- the elements. Doesn't work on infinite lists.
@@ -34,31 +35,23 @@ deduplicate = Set.toList . Set.fromList
 data Context = Context
   { cDb     :: Db T.Text
   , cVarIdx :: Int
-  , cVars   :: Map.Map Int Int
+  , cTerms  :: Map.Map Int (Term Int)
-  , cStats  :: Map.Map Int (Stat Int)
   } deriving (Show)
 
 newContext :: [Def T.Text] -> Context
-newContext db = Context db 0 Map.empty Map.empty
+newContext db = Context db 0 Map.empty
 
-bindVar :: Int -> Int -> UniM ()
+bindTerm :: Int -> Term Int -> UniM ()
-bindVar k v = modify $ \c -> c{cVars = Map.insert k v $ cVars c}
+bindTerm k v = modify $ \c -> c{cTerms = Map.insert k v $ cTerms c}
-
-bindStat :: Int -> Stat Int -> UniM ()
-bindStat k s = modify $ \c -> c{cStats = Map.insert k s $ cStats c}
 
 -- | Look up a variable, first repeatedly in the var map and then the term map.
 -- Returns statements unchanged.
 --
 -- If this returns a variable, then that variable is not bound.
 lookupTerm :: Term Int -> UniM (Term Int)
-lookupTerm (TVar v) = do
+lookupTerm t = do
   c <- get
-  let lastV = follow (cVars c) v
+  pure $ follow tVar (cTerms c) t
-  pure $ case cStats c Map.!? lastV of
-    Nothing -> TVar lastV
-    Just s  -> TStat s
-lookupTerm t@(TStat _) = pure t
 
 -- | A simple state monad transformer over the list monad for easy backtracking.
 -- Needs to be changed when implementing cuts.
@@ -101,9 +94,10 @@ unifyTerm t1 t2 = do
   t2' <- lookupTerm t2
   case (t1', t2') of
     (TStat s1, TStat s2) -> unifyStat s1 s2
-    (TVar v, TStat s)    -> bindStat v s
+    (TInt i1, TInt i2)   -> guard $ i1 == i2
-    (TStat s, TVar v)    -> bindStat v s
+    (TVar v, t)          -> bindTerm v t
-    (TVar v1, TVar v2)   -> bindVar v1 v2 -- The order shouldn't really matter
+    (t, TVar v)          -> bindTerm v t
+    (_, _)               -> empty
 
 unifyTerms :: [Term Int] -> [Term Int] -> UniM ()
 unifyTerms t1 t2 = do
@@ -125,9 +119,10 @@ varNames = do
 -- | Find a naming (Map from integer to name) for all variables in a list of
 -- terms based on the original variable names and the variable mapping. Attempts
 -- to map variables to known variables instead of a common unknown variable.
-findVarNaming :: Map.Map T.Text Int -> Map.Map Int Int -> [Term Int] -> Map.Map Int T.Text
+findVarNaming :: Map.Map T.Text Int -> Map.Map Int (Term Int) -> [Term Int] -> Map.Map Int T.Text
 findVarNaming known vars terms =
-  let knownLookedUp = fmap (follow vars) known
+  let knownLookedUp :: Map.Map T.Text Int
+      knownLookedUp = Map.mapMaybe (tVar . follow tVar vars . TVar) known
       knownNaming = Map.fromList $ reverse $ map swap $ Map.toList knownLookedUp
       knownNames = Map.keysSet known
       knownVars = Map.keysSet knownNaming
@@ -142,7 +137,8 @@ resolveVars :: Term Int -> UniM (Term Int)
 resolveVars t = do
   t2 <- lookupTerm t
   case t2 of
-    (TVar v) -> pure $ TVar v
+    (TVar v)                 -> pure $ TVar v
+    (TInt i)                 -> pure $ TInt i
     (TStat (Stat name args)) -> TStat . Stat name <$> traverse resolveVars args
 
 -- | Helper type so I can resolve variables in multiple statements
@@ -163,5 +159,5 @@ run db stats = map fst $ runStateT helper $ newContext db
       satisfyStats $ unStats stats2
       tmap <- traverse (resolveVars . TVar) vmap
       c <- get
-      let naming = findVarNaming vmap (cVars c) $ Map.elems tmap
+      let naming = findVarNaming vmap (cTerms c) $ Map.elems tmap
       pure $ fmap (naming Map.!) <$> tmap