From 9d7868431792dcd94ec71adb9f95f55ab4bf027d Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 12 Nov 2022 23:25:50 +0100
Subject: [PATCH] reorg 1

---
 app/Builtins.hs    |  2 +-
 app/Code.hs        |  7 +++++--
 app/Env.hs         | 12 ++----------
 app/Frontend.hs    |  8 ++++----
 app/Interpreter.hs | 49 ++++++++++++++++++++++++----------------------
 5 files changed, 38 insertions(+), 40 deletions(-)

diff --git a/app/Builtins.hs b/app/Builtins.hs
index eb62526..06c35a3 100644
--- a/app/Builtins.hs
+++ b/app/Builtins.hs
@@ -1,6 +1,6 @@
 module Builtins where
 
-import Code hiding (defs)
+import Code
 import Control.Monad.Trans.State.Lazy
 import qualified Data.Map as M
 import Env
diff --git a/app/Code.hs b/app/Code.hs
index 53d2e8f..00d1d1c 100644
--- a/app/Code.hs
+++ b/app/Code.hs
@@ -1,7 +1,8 @@
 module Code where
 
 import qualified Data.Map as M
-import IR (Id(..))
+import IR (Id(..), StrTable)
+import Operators (Ops)
 
 data Datum
   = Atom Int -- unifies a constant
@@ -56,8 +57,10 @@ data Cho =
 
 data Interp =
   Interp
-    { defs :: Defs -- global definitions for lookup (TODO can we externalize?)
+    { defs :: Defs -- global definitions for lookup
     , cur :: Cho -- the choice that is being evaluated right now
     , cho :: [Cho] -- remaining choice points
+    , ops :: Ops -- currently defined operators
+    , strtable :: StrTable -- string table
     }
   deriving (Show)
diff --git a/app/Env.hs b/app/Env.hs
index 7ede4c2..ba86c9e 100644
--- a/app/Env.hs
+++ b/app/Env.hs
@@ -1,21 +1,13 @@
 module Env where
 
-import qualified Code
+import Code (Interp (..))
 import Control.Monad.IO.Class
 import Control.Monad.Trans.State.Lazy
 import qualified IR
 import qualified Operators
 import System.Console.Haskeline
 
-data PrlgState =
-  PrlgState
-    { defs :: Code.Defs
-    , ops :: Operators.Ops
-    , strtable :: IR.StrTable
-    }
-  deriving (Show)
-
-type PrlgEnv a = StateT PrlgState (InputT IO) a
+type PrlgEnv a = StateT Code.Interp (InputT IO) a
 
 withStrTable :: (IR.StrTable -> (IR.StrTable, a)) -> PrlgEnv a
 withStrTable f = do
diff --git a/app/Frontend.hs b/app/Frontend.hs
index 1adf39b..0677889 100644
--- a/app/Frontend.hs
+++ b/app/Frontend.hs
@@ -1,7 +1,7 @@
 module Frontend where
 
 import Builtins
-import qualified Code
+import Code (Interp(..))
 import qualified Compiler as C
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
@@ -53,11 +53,11 @@ interpret = (>> return True) . lex
       compile prlgv
     compile prlgv = do
       commaId <- findStruct "," 2
+      -- TODO cut
       let code = C.seqGoals $ C.compileGoals commaId prlgv
       execute code
     execute code = do
-      ds <- gets defs
-      let (_, res) = I.prove code ds
+      res <- I.prove code
       case res of
         Left err -> liftIO $ putStrLn err
         Right res ->
@@ -87,4 +87,4 @@ interpreter :: InputT IO ()
 interpreter =
   evalStateT
     interpreterStart
-    (PrlgState {defs = M.empty, ops = [], strtable = IR.emptystrtable})
+    (Interp {defs = M.empty, ops = [], strtable = IR.emptystrtable, cur=error "no cur", cho=[]})
diff --git a/app/Interpreter.hs b/app/Interpreter.hs
index ebec859..743f68b 100644
--- a/app/Interpreter.hs
+++ b/app/Interpreter.hs
@@ -1,39 +1,42 @@
 {- VAM 2P, done the lazy way -}
 module Interpreter where
 
+import Code
 --import Data.Function
 import qualified Data.Map as M
-
-import Code
+import Env (PrlgEnv(..))
 import IR (Id(..))
+import qualified Control.Monad.Trans.State.Lazy as St
 
-prove :: Code -> Defs -> (Interp, Either String Bool)
-prove g ds =
-  let i0 =
-        Interp
-          { defs = ds
-          , cur =
-              Cho
-                { hed = g
-                , hvar = emptyScope
-                , gol = [LastCall]
-                , gvar = emptyScope
-                , heap = emptyHeap
-                , stk = []
-                , cut = []
-                }
-          , cho = []
-          }
-      run (Left x) = x
-      run (Right x) = run $ proveStep Right (\i e -> Left (i, e)) x
-   in run (Right i0)
+prove :: Code -> PrlgEnv (Either String Bool)
+prove g = do
+  St.modify $ \i ->
+    i
+      { cur =
+          Cho
+            { hed = g
+            , hvar = emptyScope
+            , gol = [LastCall]
+            , gvar = emptyScope
+            , heap = emptyHeap
+            , stk = []
+            , cut = []
+            }
+      , cho = []
+      }
+  loop
+  where
+    loop = do
+      i <- St.get
+      proveStep cont finish i
+    cont i = St.put i >> loop
+    finish i res = St.put i >> return res
 
 data Dereferenced
   = FreeRef Int
   | BoundRef Int Datum
   | NoRef
 
-{- this gonna need Either String Bool for errors later -}
 proveStep :: (Interp -> a) -> (Interp -> Either String Bool -> a) -> Interp -> a
 proveStep c f i = go i
   where