commit 95b1e07dd947dbf3b2406695f720f9dd0a40d055
parent c578d780e9260490cbc3620ffce8088e8f96de52
Author: James Eversole <james@eversole.co>
Date: Sun, 29 Dec 2024 21:49:57 -0600
Adds "compiler" and CLI argument handling
Diffstat:
7 files changed, 70 insertions(+), 13 deletions(-)
diff --git a/src/Compiler.hs b/src/Compiler.hs
@@ -0,0 +1,23 @@
+module Compiler where
+
+import Eval
+import Parser
+import Research
+
+import System.IO
+
+import qualified Data.Map as Map
+
+evaluateFile :: FilePath -> IO T
+evaluateFile filePath = do
+ contents <- readFile filePath
+ let linesOfFile = lines contents
+ let env = foldl evaluateLine Map.empty linesOfFile
+ case Map.lookup "__result" env of
+ Just finalResult -> return finalResult
+ Nothing -> error "No result found in final environment"
+
+evaluateLine :: Env -> String -> Env
+evaluateLine env line =
+ let ast = parseSingle line
+ in evalSingle env ast
diff --git a/src/Library.hs b/src/Library.hs
@@ -6,7 +6,7 @@ import Research
import qualified Data.Map as Map
-library :: Map.Map String T
+library :: Env
library = evalTricu Map.empty $ parseTricu $ unlines
[ "false = t"
, "true = t t"
diff --git a/src/Main.hs b/src/Main.hs
@@ -1,5 +1,6 @@
module Main where
+import Compiler
import Eval (evalTricu, result)
import Library (library)
import Parser (parseTricu)
@@ -7,16 +8,40 @@ import REPL (repl)
import Research (T)
import Text.Megaparsec (runParser)
+import System.Console.CmdArgs
import qualified Data.Map as Map
+data TricuArgs
+ = Repl
+ | Compile { file :: FilePath }
+ deriving (Show, Data, Typeable)
+
+replMode :: TricuArgs
+replMode = Repl
+ &= help "Start interactive REPL"
+ &= auto
+ &= name "repl"
+
+compileMode :: TricuArgs
+compileMode = Compile { file = def &= typ "FILE" &= help "Relative or absolute path to compile" }
+ &= help "Compile a file and return the result of the expression in the final line"
+ &= explicit
+ &= name "compile"
+
main :: IO ()
main = do
- putStrLn "Welcome to the tricu Interpreter"
- putStrLn "You can exit at any time by typing and entering: "
- putStrLn ":_exit"
- repl library
-
-runTricu :: String -> T
-runTricu s = result (evalTricu Map.empty $ parseTricu s)
-runTricuEnv env s = result (evalTricu env $ parseTricu s)
+ args <- cmdArgs $ modes [replMode, compileMode]
+ &= help "tricu: Exploring Tree Calculus"
+ &= program "tricu"
+ &= summary "tricu - compiler and repl"
+
+ case args of
+ Repl -> do
+ putStrLn "Welcome to the tricu REPL"
+ putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
+ repl Map.empty
+ Compile filePath -> do
+ result <- evaluateFile filePath
+ print result
+
diff --git a/src/REPL.hs b/src/REPL.hs
@@ -12,10 +12,10 @@ import System.Console.Haskeline
import qualified Data.Map as Map
-repl :: Map.Map String T -> IO ()
+repl :: Env -> IO ()
repl env = runInputT defaultSettings (loop env)
where
- loop :: Map.Map String T -> InputT IO ()
+ loop :: Env -> InputT IO ()
loop env = do
minput <- getInputLine "tricu < "
case minput of
@@ -28,7 +28,7 @@ repl env = runInputT defaultSettings (loop env)
newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
loop newEnv
- processInput :: Map.Map String T -> String -> IO (Map.Map String T)
+ processInput :: Env -> String -> IO (Env)
processInput env input = do
let clearEnv = Map.delete "__result" env
newEnv = evalSingle clearEnv (parseSingle input)
@@ -39,7 +39,7 @@ repl env = runInputT defaultSettings (loop env)
Nothing -> return ()
return newEnv
- errorHandler :: Map.Map String T -> SomeException -> IO (Map.Map String T)
+ errorHandler :: Env -> SomeException -> IO (Env)
errorHandler env e = do
putStrLn $ "Error: " ++ show e
return env
diff --git a/src/Research.hs b/src/Research.hs
@@ -89,6 +89,8 @@ toList (Fork x rest) = case toList rest of
toList _ = Left "Invalid Tree Calculus list"
-- Utility
+type Env = Map.Map String T
+
toAscii :: T -> String
toAscii tree = go tree "" True
where
diff --git a/test.tri b/test.tri
@@ -0,0 +1,2 @@
+x = t t t
+x
diff --git a/tricu.cabal b/tricu.cabal
@@ -19,6 +19,7 @@ executable tricu
default-extensions:
ConstraintKinds
DataKinds
+ DeriveDataTypeable
DeriveGeneric
FlexibleContexts
FlexibleInstances
@@ -28,11 +29,13 @@ executable tricu
ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
build-depends:
base >=4.7
+ , cmdargs
, containers
, haskeline
, megaparsec
, mtl
other-modules:
+ Compiler
Eval
Lexer
Library
@@ -47,6 +50,7 @@ test-suite tricu-tests
hs-source-dirs: test, src
build-depends:
base
+ , cmdargs
, containers
, haskeline
, megaparsec
@@ -56,6 +60,7 @@ test-suite tricu-tests
, tasty-quickcheck
default-language: Haskell2010
other-modules:
+ Compiler
Eval
Lexer
Library
