commit 21d4fe3949bd461338dd3d1459cc15532c083164 Author: Nyeogmi Date: Sat Apr 12 15:19:19 2025 -0700 Initial changes diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..9a11aa0 --- /dev/null +++ b/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. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..fa6d401 --- /dev/null +++ b/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. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..7af17c5 --- /dev/null +++ b/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!" + +-} \ No newline at end of file diff --git a/app/Main.hs.old1 b/app/Main.hs.old1 new file mode 100644 index 0000000..deedc0c --- /dev/null +++ b/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!" diff --git a/app/Main.hs.old2 b/app/Main.hs.old2 new file mode 100644 index 0000000..4032f98 --- /dev/null +++ b/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!" + +-} \ No newline at end of file diff --git a/prolog-in-haskell.cabal b/prolog-in-haskell.cabal new file mode 100644 index 0000000..4b5b4ae --- /dev/null +++ b/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