reorg 1

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

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)

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 =
+type PrlgEnv a = StateT Code.Interp (InputT IO) a
-  PrlgState
-    { defs :: Code.Defs
-    , ops :: Operators.Ops
-    , strtable :: IR.StrTable
-    }
-  deriving (Show)
-
-type PrlgEnv a = StateT PrlgState (InputT IO) a
 
 withStrTable :: (IR.StrTable -> (IR.StrTable, a)) -> PrlgEnv a
 withStrTable f = do

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
+      res <- I.prove code
-      let (_, res) = I.prove code ds
       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=[]})

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 Env (PrlgEnv(..))
-import Code
 import IR (Id(..))
+import qualified Control.Monad.Trans.State.Lazy as St
 
-prove :: Code -> Defs -> (Interp, Either String Bool)
+prove :: Code -> PrlgEnv (Either String Bool)
-prove g ds =
+prove g = do
-  let i0 =
+  St.modify $ \i ->
-        Interp
+    i
-          { defs = ds
+      { cur =
-          , cur =
+          Cho
-              Cho
+            { hed = g
-                { hed = g
+            , hvar = emptyScope
-                , hvar = emptyScope
+            , gol = [LastCall]
-                , gol = [LastCall]
+            , gvar = emptyScope
-                , gvar = emptyScope
+            , heap = emptyHeap
-                , heap = emptyHeap
+            , stk = []
-                , stk = []
+            , cut = []
-                , cut = []
+            }
-                }
+      , cho = []
-          , cho = []
+      }
-          }
+  loop
-      run (Left x) = x
+  where
-      run (Right x) = run $ proveStep Right (\i e -> Left (i, e)) x
+    loop = do
-   in run (Right i0)
+      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