From 14b77cd058ad3780d73df8bb41be946599150d18 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Mon, 24 Oct 2022 23:43:35 +0200
Subject: this.

---
 app/Main.hs | 59 ++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 32 insertions(+), 27 deletions(-)

(limited to 'app/Main.hs')

diff --git a/app/Main.hs b/app/Main.hs
index 5b9ed07..88b1782 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,7 +1,12 @@
 module Main where
 
+import qualified Compiler as C
+import Control.Monad.IO.Class
 import qualified Data.Map as M
-import Interpreter
+import qualified Interpreter as I
+import qualified Parser as P
+import System.Console.Haskeline
+import qualified Text.Megaparsec as MP
 import Text.Pretty.Simple
 
 ppr :: Show a => a -> IO ()
@@ -14,30 +19,30 @@ ppr =
       , outputOptionsPageWidth = 80
       }
 
-main :: IO ()
-main = do
-  let (res, interp) =
-        prove [Goal, U (Struct $ Id 1 2), U (Atom 1), U (Atom 2), LastCall] $
-        M.fromList
-          [ ( Id 1 2
-            , [ [U (Atom 333), U (Atom 444), NoGoal]
-              , [ U (Atom 1)
-                , U (Atom 2)
-                , Goal
-                , U (Struct $ Id 2 0)
-                , Call
-                , Goal
-                , U (Struct $ Id 1 2)
-                , U (Atom 333)
-                , U (Atom 444)
-                , LastCall
-                ]
-              ])
-          , (Id 2 0, [[NoGoal]])
-          ]
-  ppr interp
-  ppr res
+interpret :: String -> InputT IO ()
+interpret = liftIO . lex
+  where
+    lex input =
+      case MP.parse P.lexPrlg "-" input of
+        Left bundle -> putStr (MP.errorBundlePretty bundle)
+        Right toks -> parse toks
+    parse toks =
+      case MP.parse P.parsePrlg "-" toks of
+        Left bundle -> putStr (MP.errorBundlePretty bundle)
+        Right ast -> prologize ast
+    prologize ast = ppr $ map (P.ast2prlg P.defaultOps) ast
 
-{-
-ppr $ let { Right l = parse lexPrlg "stdin" "c(cc(X)) :- a, b. " ; Right p = parse parsePrlg "stdin" l; clause:_ = map (ast2prlg defaultOps) p; ((StrTable _ strfwd strback),codei) = strtablizePrlg emptystrtable clause } in compileRule (Id (strfwd M.! ":-") 2) (Id (strfwd M.! ",") 2) codei
- -}
+main :: IO ()
+main =
+  runInputT defaultSettings $ do
+    outputStrLn "PRLG."
+    loop
+  where
+    loop :: InputT IO ()
+    loop = do
+      minput <- getInputLine "|= "
+      case minput of
+        Nothing -> return ()
+        Just input -> do
+          interpret input
+          loop
-- 
cgit v1.2.3