summaryrefslogtreecommitdiffstats
path: root/src/main.hs
blob: 39caad9ac9cec81be9dbd47b7dc9c1edbd4c0fb0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module Main where

import Control.Monad.Except
import Data.Char
import Data.Map (Map, (!))
import qualified Data.Map as M
import Debug.Trace (trace, traceShow)
import Interpreter
import LTypes
import Parser
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
import Utils

getConfig config [] = config
getConfig config ("--debug" : rest) =
  let newConfig = config {configDebugMode = True}
   in getConfig newConfig rest
getConfig config (fileName : rest) =
  let newConfig = config {configFileNameM = Just fileName}
   in getConfig newConfig rest

getFileName :: Config -> ExceptT LException IO String
getFileName Config {configFileNameM = fileNameM} = do
  case fileNameM of
    Just str -> pure str
    Nothing -> throwError $ LException "no file name specified"

bootstrap :: [String] -> ExceptT LException IO ()
bootstrap args = do
  let initialConfig =
        Config
          { configFileNameM = Nothing,
            configDebugMode = False
          }
  let config = getConfig initialConfig args
  fileName <- getFileName config

  debugPrint config $ "executing file " ++ fileName ++ "\n"
  source <- liftIO . readFile $ fileName
  (parsedSource, strLitRefMap) <- parseSource source
  debugPrint config $ "parsed words:\n" ++ show parsedSource ++ "\n"
  debugPrint config $ "string literal refmap:\n" ++ show strLitRefMap ++ "\n"
  debugPrint config "interpreter output:"
  let initialState =
        LState
          { lDict = M.empty,
            lStack = [],
            lPhraseDepth = 0,
            lDefs = M.empty,
            lSource = parsedSource,
            lStrLitRefMap = strLitRefMap
          }
  interpretSource config initialState

main :: IO ()
main = do
  args <- getArgs
  result <- runExceptT $ bootstrap args
  case result of
    Left ex -> case ex of
      LException errStr -> do
        putStrLn $ "[error] " ++ errStr
        exitFailure
    _ -> exitSuccess