Initial changes

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for prolog-in-haskell
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,29 @@
+Copyright (c) 2025, Nyeogmi
+
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the copyright holder nor the names of its
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

app/Main.hs

@@ -0,0 +1,237 @@
+{-# LANGUAGE InstanceSigs #-}
+module Main where
+
+import Control.Monad 
+import qualified Data.Map.Lazy as M
+import Data.IORef
+import Control.Monad.RWS (MonadTrans(lift))
+import Control.Applicative
+
+data Atomic
+  = AString String
+  deriving (Eq, Show)
+
+data Name
+  = NString String
+  deriving (Ord, Eq, Show)
+
+data Term 
+  = TCompound Atomic [Term] -- functor, args
+  | TVariable Name  -- name
+  deriving (Eq, Show)
+
+type Vars = M.Map Name Term
+
+emptyVars :: Vars 
+emptyVars = M.empty
+
+
+data Globals = Globals {
+  psVars :: IORef Vars
+}
+
+newtype PrologIO a = PrologIO (Globals -> IO a)
+
+instance Functor PrologIO where
+  fmap :: (a -> b) -> PrologIO a -> PrologIO b
+  fmap f (PrologIO a) = PrologIO (\globals -> fmap f (a globals))
+
+instance Applicative PrologIO where
+  pure :: a -> PrologIO a
+  pure x = PrologIO (\_ -> pure x)
+
+  (PrologIO f) <*> (PrologIO x) = PrologIO (
+    \globals -> do
+      f' <- f globals
+      x' <- x globals
+      pure (f' x')
+    )
+
+instance Monad PrologIO where
+  return :: a -> PrologIO a
+  return = pure
+
+  (PrologIO a) >>= f = PrologIO (
+    \globals -> do
+      a' <- a globals
+      let PrologIO b' = f a'
+      b' globals
+    )
+
+runPrologIO :: Globals -> PrologIO a -> IO a
+runPrologIO globals (PrologIO a) = a globals
+
+data Suspend a = Yield a | Suspend
+
+instance Functor Suspend where
+  fmap f (Yield a) = Yield (f a)
+  fmap _ Suspend = Suspend
+
+data PrologStream a 
+  = PYes (Suspend a) (PrologIO (PrologStream a))
+  | PNo
+
+instance Functor PrologStream where
+  fmap :: (a -> b) -> PrologStream a -> PrologStream b
+  fmap f (PYes a next) = PYes (fmap f a) (fmap (fmap f) next)
+  fmap _ PNo = PNo
+
+instance Applicative PrologStream where
+  pure :: a -> PrologStream a
+  pure x = PYes (Yield x) (pure PNo)
+
+  (<*>) :: PrologStream (a -> b) -> PrologStream a -> PrologStream b
+  f <*> x = f >>= (\f' -> x >>= (\x' -> return (f' x')))
+
+instance Monad PrologStream where
+  return :: a -> PrologStream a
+  return = pure
+
+  (>>=) :: PrologStream a -> (a -> PrologStream b) -> PrologStream b
+  PNo >>= _ = PNo
+  PYes (Yield x) xs >>= f = f x <|> PYes Suspend (fmap (>>= f) xs)
+  PYes Suspend xs >>= f = PYes Suspend (fmap (>>= f) xs)
+
+instance Alternative PrologStream where 
+  empty :: PrologStream a
+  empty = PNo
+
+  (<|>) :: PrologStream a -> PrologStream a -> PrologStream a
+  (<|>) = append
+
+
+instance MonadPlus PrologStream where
+  mzero :: PrologStream a
+  mzero = empty
+
+  mplus :: PrologStream a -> PrologStream a -> PrologStream a
+  mplus = (<|>)
+
+
+append :: PrologStream a -> PrologStream a -> PrologStream a
+append (PYes x xs) next = PYes x (liftM2 append xs (return next))
+append PNo next = next
+
+
+data Thread a = Thread 
+  { threadGlobals :: Globals
+  , threadStream :: IORef (PrologStream a)
+  }
+
+startThread :: PrologStream a -> IO (Thread a)
+startThread stream = do
+  vars <- newIORef emptyVars
+  streamRef <- newIORef stream 
+  let globals = Globals { psVars = vars }
+  return (Thread { threadGlobals = globals, threadStream = streamRef })
+
+advanceThread :: Thread a -> IO (Maybe a)
+advanceThread (Thread { threadGlobals = globals, threadStream = streamRef }) = do
+  stream <- readIORef streamRef
+  (value, newStream) <- runPrologIO globals (squeeze stream)
+  writeIORef streamRef newStream
+  return value
+
+completeThread :: Thread a -> IO [a]
+completeThread thread = do
+  value <- advanceThread thread
+  case value of 
+    Nothing -> return []
+    Just x -> fmap (x:) (completeThread thread)
+
+squeeze :: PrologStream a -> PrologIO (Maybe a, PrologStream a)
+squeeze PNo = return (Nothing, PNo)
+squeeze (PYes Suspend rest) = rest >>= squeeze
+squeeze (PYes (Yield x) rest) = fmap ((,) (Just x)) rest 
+
+exitUndo :: PrologIO a -> PrologIO () -> PrologStream a
+exitUndo exit undo = 
+  PYes Suspend $ exit >>= \v -> return $ 
+    PYes (Yield v) $ undo >>= \_ -> return $
+      PNo
+
+liftPrologIO :: PrologIO a -> PrologStream a
+liftPrologIO exit = exitUndo exit (return ())
+
+liftIO :: IO a -> PrologStream a
+liftIO x = liftPrologIO $ PrologIO (\_ -> x)
+
+setVar :: Name -> Term -> PrologStream ()
+setVar name value = exitUndo exit undo
+  where 
+  exit = PrologIO (
+    \globals -> do 
+      let varsRef = psVars globals
+      modifyIORef varsRef (M.insert name value)
+    )
+  undo = PrologIO (
+    \globals -> do
+      let varsRef = psVars globals
+      modifyIORef varsRef (M.delete name)
+    )
+
+getVar :: Name -> PrologStream (Maybe Term)
+getVar name = exitUndo exit undo
+  where
+  exit = PrologIO (
+    \globals -> do
+      let varsRef = psVars globals
+      vars <- readIORef varsRef
+      return (M.lookup name vars)
+    )
+  undo = PrologIO (\_ -> return ())
+
+  
+demoProgram :: PrologStream ()
+demoProgram = do
+  setVar (NString "bat") (TCompound (AString "Nyeogmi") []) <|> setVar (NString "bat") (TCompound (AString "Pyrex") []) 
+  setVar (NString "activity") (TCompound (AString "drinks blood") []) <|> setVar (NString "activity") (TCompound (AString "spits venom") []) 
+  who <- getVar (NString "bat")
+  what <- getVar (NString "activity")
+  liftIO (print ("Value: ", who, "What: ", what))
+
+
+main :: IO ()
+main = do
+  thread <- startThread demoProgram
+  results <- completeThread thread
+  putStrLn ("Results: " ++ show results)
+{-
+no :: Prolog a
+no = Prolog (\_ -> [])
+
+readVars :: Prolog Vars
+readVars = Prolog (\vars -> [(vars, vars)])
+
+writeVars :: Vars -> Prolog ()
+writeVars vars = Prolog (\_ -> [((), vars)])
+
+unify :: Term -> Term -> Prolog ()
+unify = unify_ []
+  where
+  unify_ :: [Name] -> Term -> Term -> Prolog ()
+  unify_ names (TCompound h0 args0) (TCompound h1 args1) = do
+    when (h0 /= h1) no
+    when (length args0 /= length args1) no
+    forM_ (zip args0 args1) $ \(arg0, arg1) -> unify_ names arg0 arg1
+  unify_ _ (TVariable name0) (TVariable name1) | name0 == name1 = return ()
+  unify_ names (TVariable name) y = do
+    -- occurs check
+    when (name `elem` names) no
+    -- unify as usual
+    (Vars vs0) <- readVars
+    case M.lookup name vs0 of
+      Just existing -> unify_ (name:names) existing y
+      Nothing -> do
+        let vs1 = M.insert name y vs0
+        writeVars (Vars vs1)
+  unify_ names x@(TCompound _ _) y@(TVariable _) = unify_ names y x
+
+
+
+
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"
+
+-}

app/Main.hs.old1

@@ -0,0 +1,99 @@
+{-# LANGUAGE InstanceSigs #-}
+module Main where
+
+import Control.Monad 
+import Control.Monad.State.Lazy
+import qualified Data.Map.Lazy as M
+import GHC.Conc (TVar(TVar))
+
+data Atomic
+  = AString String
+  deriving (Eq, Show)
+
+data Name
+  = NString String
+  deriving (Ord, Eq, Show)
+
+data Term 
+  = TCompound Atomic [Term] -- functor, args
+  | TVariable Name  -- name
+  deriving (Eq, Show)
+
+data Vars
+  = Vars { varsBindings :: M.Map Name Term }
+
+emptyVars :: Vars 
+emptyVars = Vars { varsBindings = M.empty }
+
+newtype Prolog a = Prolog (Vars -> [(a, Vars)])
+
+instance Functor Prolog where
+  fmap :: (a -> b) -> Prolog a -> Prolog b
+  fmap f (Prolog x) = Prolog (\v0 -> [(f a, v1) | (a, v1) <- x v0])
+
+instance Applicative Prolog where
+  pure :: a -> Prolog a
+  pure x = Prolog (\_ -> [(x, emptyVars)])
+
+  (<*>) :: Prolog (a -> b) -> Prolog a -> Prolog b
+  (Prolog f) <*> (Prolog x) = Prolog body
+    where 
+    body vars0 
+      = [
+        (function argument, vars2) |
+        (function, vars1) <- f vars0,
+        (argument, vars2) <- x vars1
+      ]
+
+instance Monad Prolog where
+  return :: a -> Prolog a
+  return = pure
+
+  (>>=) :: Prolog a -> (a -> Prolog b) -> Prolog b
+  (Prolog a0) >>= f = Prolog body
+    where
+    body vars0 
+      = [
+        (b1, vars2) |
+        (a1, vars1) <- a0 vars0,
+        let Prolog b = f a1,
+        (b1, vars2) <- (b vars1)
+      ]
+
+
+no :: Prolog a
+no = Prolog (\_ -> [])
+
+readVars :: Prolog Vars
+readVars = Prolog (\vars -> [(vars, vars)])
+
+writeVars :: Vars -> Prolog ()
+writeVars vars = Prolog (\_ -> [((), vars)])
+
+unify :: Term -> Term -> Prolog ()
+unify = unify_ []
+  where
+  unify_ :: [Name] -> Term -> Term -> Prolog ()
+  unify_ names (TCompound h0 args0) (TCompound h1 args1) = do
+    when (h0 /= h1) no
+    when (length args0 /= length args1) no
+    forM_ (zip args0 args1) $ \(arg0, arg1) -> unify_ names arg0 arg1
+  unify_ _ (TVariable name0) (TVariable name1) | name0 == name1 = return ()
+  unify_ names (TVariable name) y = do
+    -- occurs check
+    when (name `elem` names) no
+    -- unify as usual
+    (Vars vs0) <- readVars
+    case M.lookup name vs0 of
+      Just existing -> unify_ (name:names) existing y
+      Nothing -> do
+        let vs1 = M.insert name y vs0
+        writeVars (Vars vs1)
+  unify_ names x@(TCompound _ _) y@(TVariable _) = unify_ names y x
+
+
+
+
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"

app/Main.hs.old2

@@ -0,0 +1,167 @@
+{-# LANGUAGE InstanceSigs #-}
+module Main where
+
+import Control.Monad 
+import qualified Data.Map.Lazy as M
+import Data.IORef
+
+data Atomic
+  = AString String
+  deriving (Eq, Show)
+
+data Name
+  = NString String
+  deriving (Ord, Eq, Show)
+
+data Term 
+  = TCompound Atomic [Term] -- functor, args
+  | TVariable Name  -- name
+  deriving (Eq, Show)
+
+data Vars
+  = Vars { varsBindings :: M.Map Name Term }
+
+emptyVars :: Vars 
+emptyVars = Vars { varsBindings = M.empty }
+
+
+data Globals = Globals {
+  psVars :: IORef Vars
+}
+
+newtype PrologIO a = PrologIO (Globals -> IO a)
+
+instance Functor PrologIO where
+  fmap :: (a -> b) -> PrologIO a -> PrologIO b
+  fmap f (PrologIO a) = PrologIO (\globals -> fmap f (a globals))
+
+instance Applicative PrologIO where
+  pure :: a -> PrologIO a
+  pure x = PrologIO (\_ -> pure x)
+
+  (PrologIO f) <*> (PrologIO x) = PrologIO (
+    \globals -> do
+      f' <- f globals
+      x' <- x globals
+      pure (f' x')
+    )
+
+instance Monad PrologIO where
+  return :: a -> PrologIO a
+  return = pure
+
+  (PrologIO a) >>= f = PrologIO (
+    \globals -> do
+      a' <- a globals
+      let PrologIO b' = f a'
+      b' globals
+    )
+
+runPrologIO :: Globals -> PrologIO a -> IO a
+runPrologIO globals (PrologIO a) = a globals
+
+data PrologStream a 
+  = PYes (Maybe a) (PrologIO (PrologStream a))
+  | PNo
+
+instance Functor PrologStream where
+  fmap :: (a -> b) -> PrologStream a -> PrologStream b
+  fmap f (PYes a next) = PYes (fmap f a) (fmap (fmap f) next)
+  fmap _ PNo = PNo
+
+instance Monad PrologStream where
+  return :: a -> PrologStream a
+  return = pure
+
+  (>>=) :: PrologStream a -> (a -> PrologStream b) -> PrologStream b
+  x >>= f = join_ (fmap f x)
+
+instance Applicative PrologStream where
+  pure :: a -> PrologStream a
+  pure x = PYes (Just x) (pure PNo)
+
+  (<*>) :: PrologStream (a -> b) -> PrologStream a -> PrologStream b
+  f <*> x = f >>= (\f' -> x >>= (\x' -> return (f' x')))
+
+
+join_ :: PrologStream (PrologStream a) -> PrologStream a
+join_ (PNo) = PNo
+join_ (PYes Nothing rest) = PYes Nothing (fmap join_ rest)
+join_ (PYes (Just PNo) rest) = PYes Nothing (fmap join_ rest)
+join_ (PYes (Just (PYes a xs)) rest) = 
+  let joinedRest = liftM2 append xs (fmap join_ rest) in
+  PYes a joinedRest
+
+append :: PrologStream a -> PrologStream a -> PrologStream a
+append (PYes x xs) next = PYes x (liftM2 append xs (return next))
+append PNo next = next
+
+
+data Thread a = Thread 
+  { threadGlobals :: Globals
+  , threadStream :: IORef (PrologStream a)
+  }
+
+startThread :: PrologStream a -> IO (Thread a)
+startThread stream = do
+  vars <- newIORef emptyVars
+  streamRef <- newIORef stream 
+  let globals = Globals { psVars = vars }
+  return (Thread { threadGlobals = globals, threadStream = streamRef })
+
+advanceThread :: Thread a -> IO (Maybe a)
+advanceThread (Thread { threadGlobals = globals, threadStream = streamRef }) = do
+  stream <- readIORef streamRef
+  (value, newStream) <- runPrologIO globals (squeeze stream)
+  writeIORef streamRef newStream
+  return value
+
+
+squeeze :: PrologStream a -> PrologIO (Maybe a, PrologStream a)
+squeeze PNo = return (Nothing, PNo)
+squeeze (PYes (Nothing) rest) = rest >>= squeeze
+squeeze (PYes (Just x) rest) = fmap ((,) (Just x)) rest 
+
+
+main :: IO ()
+main = do
+  putStrLn "Hello, world!"
+{-
+no :: Prolog a
+no = Prolog (\_ -> [])
+
+readVars :: Prolog Vars
+readVars = Prolog (\vars -> [(vars, vars)])
+
+writeVars :: Vars -> Prolog ()
+writeVars vars = Prolog (\_ -> [((), vars)])
+
+unify :: Term -> Term -> Prolog ()
+unify = unify_ []
+  where
+  unify_ :: [Name] -> Term -> Term -> Prolog ()
+  unify_ names (TCompound h0 args0) (TCompound h1 args1) = do
+    when (h0 /= h1) no
+    when (length args0 /= length args1) no
+    forM_ (zip args0 args1) $ \(arg0, arg1) -> unify_ names arg0 arg1
+  unify_ _ (TVariable name0) (TVariable name1) | name0 == name1 = return ()
+  unify_ names (TVariable name) y = do
+    -- occurs check
+    when (name `elem` names) no
+    -- unify as usual
+    (Vars vs0) <- readVars
+    case M.lookup name vs0 of
+      Just existing -> unify_ (name:names) existing y
+      Nothing -> do
+        let vs1 = M.insert name y vs0
+        writeVars (Vars vs1)
+  unify_ names x@(TCompound _ _) y@(TVariable _) = unify_ names y x
+
+
+
+
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"
+
+-}

prolog-in-haskell.cabal

@@ -0,0 +1,76 @@
+cabal-version:      3.0
+-- The cabal-version field refers to the version of the .cabal specification,
+-- and can be different from the cabal-install (the tool) version and the
+-- Cabal (the library) version you are using. As such, the Cabal (the library)
+-- version used must be equal or greater than the version stated in this field.
+-- Starting from the specification version 2.2, the cabal-version field must be
+-- the first thing in the cabal file.
+
+-- Initial package description 'prolog-in-haskell' generated by
+-- 'cabal init'. For further documentation, see:
+--   http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name:               prolog-in-haskell
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary:     +-+------- breaking API changes
+--                  | | +----- non-breaking API additions
+--                  | | | +--- code changes with no API change
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:            BSD-3-Clause
+
+-- The file containing the license text.
+license-file:       LICENSE
+
+-- The package author(s).
+author:             Nyeogmi
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer:         economicsbat@gmail.com
+
+-- A copyright notice.
+-- copyright:
+build-type:         Simple
+
+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
+extra-doc-files:    CHANGELOG.md
+
+-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall
+
+executable prolog-in-haskell
+    -- Import common warning flags.
+    import:           warnings
+
+    -- .hs or .lhs file containing the Main module.
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    build-depends:    base ^>=4.20.0.0, containers^>=0.8, mtl^>=2.3
+
+    -- Directories containing source files.
+    hs-source-dirs:   app
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010