Compare commits

...

2 Commits

7 changed files with 69 additions and 12 deletions

23
src/Compiler.hs Normal file
View File

@ -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

View File

@ -6,7 +6,7 @@ import Research
import qualified Data.Map as Map import qualified Data.Map as Map
library :: Map.Map String T library :: Env
library = evalTricu Map.empty $ parseTricu $ unlines library = evalTricu Map.empty $ parseTricu $ unlines
[ "false = t" [ "false = t"
, "true = t t" , "true = t t"

View File

@ -1,5 +1,6 @@
module Main where module Main where
import Compiler
import Eval (evalTricu, result) import Eval (evalTricu, result)
import Library (library) import Library (library)
import Parser (parseTricu) import Parser (parseTricu)
@ -7,16 +8,40 @@ import REPL (repl)
import Research (T) import Research (T)
import Text.Megaparsec (runParser) import Text.Megaparsec (runParser)
import System.Console.CmdArgs
import qualified Data.Map as Map 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 :: IO ()
main = do main = do
putStrLn "Welcome to the tricu Interpreter" args <- cmdArgs $ modes [replMode, compileMode]
putStrLn "You can exit at any time by typing and entering: " &= help "tricu: Exploring Tree Calculus"
putStrLn ":_exit" &= program "tricu"
repl library &= 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
runTricu :: String -> T
runTricu s = result (evalTricu Map.empty $ parseTricu s)
runTricuEnv env s = result (evalTricu env $ parseTricu s)

View File

@ -12,10 +12,10 @@ import System.Console.Haskeline
import qualified Data.Map as Map import qualified Data.Map as Map
repl :: Map.Map String T -> IO () repl :: Env -> IO ()
repl env = runInputT defaultSettings (loop env) repl env = runInputT defaultSettings (loop env)
where where
loop :: Map.Map String T -> InputT IO () loop :: Env -> InputT IO ()
loop env = do loop env = do
minput <- getInputLine "tricu < " minput <- getInputLine "tricu < "
case minput of case minput of
@ -28,7 +28,7 @@ repl env = runInputT defaultSettings (loop env)
newEnv <- liftIO $ (processInput env input `catch` errorHandler env) newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
loop newEnv loop newEnv
processInput :: Map.Map String T -> String -> IO (Map.Map String T) processInput :: Env -> String -> IO (Env)
processInput env input = do processInput env input = do
let clearEnv = Map.delete "__result" env let clearEnv = Map.delete "__result" env
newEnv = evalSingle clearEnv (parseSingle input) newEnv = evalSingle clearEnv (parseSingle input)
@ -39,7 +39,7 @@ repl env = runInputT defaultSettings (loop env)
Nothing -> return () Nothing -> return ()
return newEnv return newEnv
errorHandler :: Map.Map String T -> SomeException -> IO (Map.Map String T) errorHandler :: Env -> SomeException -> IO (Env)
errorHandler env e = do errorHandler env e = do
putStrLn $ "Error: " ++ show e putStrLn $ "Error: " ++ show e
return env return env

View File

@ -89,6 +89,8 @@ toList (Fork x rest) = case toList rest of
toList _ = Left "Invalid Tree Calculus list" toList _ = Left "Invalid Tree Calculus list"
-- Utility -- Utility
type Env = Map.Map String T
toAscii :: T -> String toAscii :: T -> String
toAscii tree = go tree "" True toAscii tree = go tree "" True
where where

2
test.tri Normal file
View File

@ -0,0 +1,2 @@
x = t t t
x

View File

@ -19,6 +19,7 @@ executable tricu
default-extensions: default-extensions:
ConstraintKinds ConstraintKinds
DataKinds DataKinds
DeriveDataTypeable
DeriveGeneric DeriveGeneric
FlexibleContexts FlexibleContexts
FlexibleInstances FlexibleInstances
@ -28,11 +29,13 @@ executable tricu
ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
build-depends: build-depends:
base >=4.7 base >=4.7
, cmdargs
, containers , containers
, haskeline , haskeline
, megaparsec , megaparsec
, mtl , mtl
other-modules: other-modules:
Compiler
Eval Eval
Lexer Lexer
Library Library
@ -47,6 +50,7 @@ test-suite tricu-tests
hs-source-dirs: test, src hs-source-dirs: test, src
build-depends: build-depends:
base base
, cmdargs
, containers , containers
, haskeline , haskeline
, megaparsec , megaparsec
@ -56,6 +60,7 @@ test-suite tricu-tests
, tasty-quickcheck , tasty-quickcheck
default-language: Haskell2010 default-language: Haskell2010
other-modules: other-modules:
Compiler
Eval Eval
Lexer Lexer
Library Library