From b41711713002a8980a783d36164fbecbaddc1986 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 4 Mar 2023 13:51:22 +0100
Subject: load a prelude

---
 app/Builtins.hs | 26 ++++++++++++++++++--------
 1 file changed, 18 insertions(+), 8 deletions(-)

(limited to 'app')

diff --git a/app/Builtins.hs b/app/Builtins.hs
index 357c490..eb2dac1 100644
--- a/app/Builtins.hs
+++ b/app/Builtins.hs
@@ -1,5 +1,7 @@
 module Builtins where
 
+import Paths_prlg
+
 import Code (Builtin(..), Code, Datum(..), Instr(..), InterpFn)
 import CodeLens
 import qualified Compiler as Co
@@ -329,6 +331,17 @@ addBi b n a =
   addProc [[U (LocalRef $ r - 1) | r <- [1 .. a]] ++ [Invoke $ bi b]] n a
 
 {- loading code -}
+doLoad :: Bool -> String -> InterpFn
+doLoad queryMode fn = do
+  src' <- liftIO $ catch (Right <$> readFile fn) (pure . Left)
+  case src' of
+    Right src -> do
+      res <- runExceptT $ processInput fn queryMode src
+      case res of
+        Right _ -> continue
+        Left e -> prlgError $ "loading from '" ++ fn ++ "': " ++ e
+    Left e -> prlgError $ show (e :: IOException)
+
 load :: Bool -> InterpFn
 load queryMode =
   withArgs [0] $ \[arg] -> do
@@ -337,14 +350,7 @@ load queryMode =
     case derefHeap heap arg of
       BoundRef _ (Atom a) -> do
         let fn = itos M.! a
-        src' <- liftIO $ catch (Right <$> readFile fn) (pure . Left)
-        case src' of
-          Right src -> do
-            res <- runExceptT $ processInput fn queryMode src
-            case res of
-              Right _ -> continue
-              Left e -> prlgError $ "loading from '" ++ fn ++ "': " ++ e
-          Left e -> prlgError $ show (e :: IOException)
+        doLoad queryMode (itos M.! a)
       _ -> prlgError "load needs an atom"
 
 {- actual prlgude -}
@@ -426,3 +432,7 @@ addPrelude = do
   addBi nl "nl" 0
   {- debug -}
   addBi (use id >>= liftIO . print >> pure Nothing) "interpreter_trace" 0
+  {- load the prelude file -}
+  preludeFile <- liftIO $ getDataFileName "prelude.pl"
+  doLoad False preludeFile
+  pure ()
-- 
cgit v1.2.3