From 3bfa127cbccbc77bb1b993153d6a6a2db2ec3ee4 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Fri, 14 Oct 2022 16:56:23 +0200
Subject: [PATCH] p r l g

---
 CHANGELOG.md       |  5 +++++
 app/Interpreter.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++
 app/Main.hs        |  6 +++++
 prlg.cabal         | 34 ++++++++++++++++++++++++++++
 4 files changed, 101 insertions(+)
 create mode 100644 CHANGELOG.md
 create mode 100644 app/Interpreter.hs
 create mode 100644 app/Main.hs
 create mode 100644 prlg.cabal

diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..585dc73
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for prlg
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/app/Interpreter.hs b/app/Interpreter.hs
new file mode 100644
index 0000000..7610903
--- /dev/null
+++ b/app/Interpreter.hs
@@ -0,0 +1,56 @@
+module Interpreter where
+
+import Data.Function
+import qualified Data.Map as M
+
+{- VAM 2P, done the lazy way -}
+
+data StrTable =
+  StrTable Int (M.Map Int String)
+
+data Instr
+  = Atom Int -- unify a constant
+  | Struct (Int, Int) -- unify a structure with arity
+  | NoGoal -- trivial goal
+  | Goal -- we start a new goal, set up backtracking etc
+  | Call -- all seems okay, call the goal
+  | LastCall -- tail call the goal
+  deriving Show
+
+type Defs = M.Map (Int, Int) [Instr]
+
+data Interp =
+  Interp
+    { defs :: Defs
+    , hed :: [Instr]
+    , gol :: [Instr]
+    , stk :: [[Instr]]
+    }
+
+prove :: [Instr] -> Defs -> Bool
+prove g ds =
+  let i0 = Interp ds [NoGoal] [LastCall] [g]
+      run (Left x) = x
+      run (Right x) = run $ pr Right Left x
+   in run (Right i0)
+
+pr :: (Interp -> a) -> (Bool -> a) -> Interp -> a
+pr c f i = go i
+  where
+    go i@Interp {hed = (Atom a:hs), gol = (Atom b:gs)} -- unify constants
+      | a == b = c i {hed = hs, gol = gs}
+    go i@Interp {hed = (Struct a:hs), gol = (Struct b:gs)} -- unify structs
+      | a == b = c i {hed = hs, gol = gs}
+    go i@Interp {hed = [NoGoal], gol = [LastCall], stk = []} = f True -- final success
+    go i@Interp { hed = [NoGoal]
+                , gol = [LastCall]
+                , stk = ((Goal:Struct f:gs):ss)
+                } -- goal succeeded
+      | Just nhs <- defs i M.!? f = c i {hed = nhs, gol = gs, stk = ss}
+    go i@Interp {hed = [NoGoal], gol = (Call:Goal:Struct f:gs)} -- next goal
+      | Just nhs <- defs i M.!? f = c i {hed = nhs, gol = gs}
+    go i@Interp {hed = (Goal:Struct f:hs), gol = [LastCall]} -- tail call
+      | Just nhs <- defs i M.!? f = c i {hed = nhs, gol = hs}
+    go i@Interp {hed = (Goal:Struct f:hs), gol = (Call:gs), stk = ss} -- normal call
+      | Just nhs <- defs i M.!? f = c i {hed = nhs, gol = hs, stk = gs : ss}
+    go _ = f False -- bad luck
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..9d8fc29
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Interpreter
+
+main :: IO ()
+main = putStrLn "Hello, Prolog!"
diff --git a/prlg.cabal b/prlg.cabal
new file mode 100644
index 0000000..21da1dc
--- /dev/null
+++ b/prlg.cabal
@@ -0,0 +1,34 @@
+cabal-version:      2.4
+name:               prlg
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             Mirek Kratochvil
+maintainer:         exa.exa@gmail.com
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+executable prlg
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    other-modules: Interpreter
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base >=4.16, containers, megaparsec, haskeline
+    hs-source-dirs:   app
+    default-language: Haskell2010