commit 7abc7061d9e29bc28448444ad5dad016845d81ed
parent 78dd2f4d8fbfe3b711572ee24063ece6224748b7
Author: James Eversole <james@eversole.co>
Date: Mon, 30 Dec 2024 14:19:43 -0600
Expands CLI support with output forms and decoding
Adds CLI options for compiling to a Tree Calculus, AST, Ternary, and
ASCII tree view. Adds CLI command for attempted decoding of a compiled
result to Number/String/List.
Diffstat:
13 files changed, 131 insertions(+), 57 deletions(-)
diff --git a/src/Compiler.hs b/src/Compiler.hs
@@ -1,6 +1,7 @@
module Compiler where
import Eval
+import Library
import Parser
import Research
@@ -11,13 +12,8 @@ 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
+ let asts = parseTricu contents
+ let finalEnv = evalTricu library asts
+ case Map.lookup "__result" finalEnv 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/Eval.hs b/src/Eval.hs
@@ -30,33 +30,36 @@ evalSingle env term = case term of
in Map.insert "__result" result env
evalTricu :: Map String T -> [TricuAST] -> Map String T
-evalTricu env [] = env
-evalTricu env [lastLine] =
+evalTricu env list = evalTricu' env (filter (/= SEmpty) list)
+ where
+ evalTricu' :: Map String T -> [TricuAST] -> Map String T
+ evalTricu' env [] = env
+ evalTricu' env [lastLine] =
let lastLineNoLambda = eliminateLambda lastLine
updatedEnv = evalSingle env lastLineNoLambda
in Map.insert "__result" (result updatedEnv) updatedEnv
-evalTricu env (line:rest) =
+ evalTricu' env (line:rest) =
let lineNoLambda = eliminateLambda line
updatedEnv = evalSingle env lineNoLambda
in evalTricu updatedEnv rest
evalAST :: Map String T -> TricuAST -> T
evalAST env term = case term of
- SVar name -> case Map.lookup name env of
- Just value -> value
- Nothing -> error $ "Variable " ++ name ++ " not defined"
- TLeaf -> Leaf
- TStem t -> Stem (evalAST env t)
- TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
- SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
- SStr str -> ofString str
- SInt num -> ofNumber num
- SList elems -> ofList (map (evalAST Map.empty) elems)
- SEmpty -> Leaf
- SFunc name args body ->
- error $ "Unexpected function definition " ++ name
- ++ " in evalAST; define via evalSingle."
- SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
+ SVar name -> case Map.lookup name env of
+ Just value -> value
+ Nothing -> error $ "Variable " ++ name ++ " not defined"
+ TLeaf -> Leaf
+ TStem t -> Stem (evalAST env t)
+ TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
+ SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
+ SStr str -> ofString str
+ SInt num -> ofNumber num
+ SList elems -> ofList (map (evalAST Map.empty) elems)
+ SEmpty -> Leaf
+ SFunc name args body ->
+ error $ "Unexpected function definition " ++ name
+ ++ " in evalAST; define via evalSingle."
+ SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
eliminateLambda :: TricuAST -> TricuAST
eliminateLambda (SLambda (v:vs) body)
@@ -117,5 +120,5 @@ tS = SApp (SApp TLeaf (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf))) TLeaf
result :: Map String T -> T
result r = case Map.lookup "__result" r of
- Just a -> a
- Nothing -> error "No __result field found in provided environment"
+ Just a -> a
+ Nothing -> error "No __result field found in provided environment"
diff --git a/src/Library.hs b/src/Library.hs
@@ -37,7 +37,7 @@ library = evalTricu Map.empty $ parseTricu $ unlines
, "emptyList = matchList true (\\y z : false)"
, "head = matchList t (\\hd tl : hd)"
, "tail = matchList t (\\hd tl : tl)"
- , "listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
+ , "lconcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
, "lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)"
, "lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)"
, "hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))"
diff --git a/src/Main.hs b/src/Main.hs
@@ -1,11 +1,11 @@
module Main where
import Compiler
-import Eval (evalTricu, result)
+import Eval (evalTricu, result, toAST)
import Library (library)
import Parser (parseTricu)
-import REPL (repl)
-import Research (T)
+import REPL
+import Research
import Text.Megaparsec (runParser)
import System.Console.CmdArgs
@@ -14,7 +14,11 @@ import qualified Data.Map as Map
data TricuArgs
= Repl
- | Compile { file :: FilePath }
+ | Compile { file :: FilePath, output :: Maybe FilePath, form :: CompiledForm }
+ | Decode { input :: Maybe FilePath }
+ deriving (Show, Data, Typeable)
+
+data CompiledForm = TreeCalculus | AST | Ternary | Ascii
deriving (Show, Data, Typeable)
replMode :: TricuArgs
@@ -24,14 +28,31 @@ replMode = Repl
&= name "repl"
compileMode :: TricuArgs
-compileMode = Compile { file = def &= typ "FILE" &= help "Relative or absolute path to compile" }
+compileMode = Compile
+ { file = def &= typ "FILE"
+ &= help "Relative or absolute path to file input for compilation" &= name "f"
+ , output = def &= typ "OUTPUT"
+ &= help "Optional output file path for resulting output" &= name "o"
+ , form = TreeCalculus &= typ "FORM"
+ &= help "Output form: (tree|ast|ternary|ascii)"
+ &= name "t"
+ }
&= help "Compile a file and return the result of the expression in the final line"
&= explicit
&= name "compile"
+decodeMode :: TricuArgs
+decodeMode = Decode
+ { input = def &= typ "FILE"
+ &= help "Optional file path containing a Tree Calculus value. Defaults to stdin." &= name "f"
+ }
+ &= help "Decode a Tree Calculus value into a string representation"
+ &= explicit
+ &= name "decode"
+
main :: IO ()
main = do
- args <- cmdArgs $ modes [replMode, compileMode]
+ args <- cmdArgs $ modes [replMode, compileMode, decodeMode]
&= help "tricu: Exploring Tree Calculus"
&= program "tricu"
&= summary "tricu - compiler and repl"
@@ -41,7 +62,22 @@ main = do
putStrLn "Welcome to the tricu REPL"
putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
repl library
- Compile filePath -> do
+ Compile { file = filePath, output = maybeOutputPath, form = form } -> do
result <- evaluateFile filePath
- print result
+ let fRes = formatResult form result
+ case maybeOutputPath of
+ Just outputPath -> do
+ writeFile outputPath fRes
+ putStrLn $ "Output to: " ++ outputPath
+ Nothing -> putStr fRes
+ Decode { input = maybeInputPath } -> do
+ value <- case maybeInputPath of
+ Just inputPath -> readFile inputPath
+ Nothing -> getContents
+ putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value
+formatResult :: CompiledForm -> T -> String
+formatResult TreeCalculus = show
+formatResult AST = show . toAST
+formatResult Ternary = toTernaryString
+formatResult Ascii = toAscii
diff --git a/src/Parser.hs b/src/Parser.hs
@@ -296,4 +296,3 @@ showError (FancyError offset fancy) =
showError (TrivialError offset Nothing expected) =
"Parse error at offset " ++ show offset ++ ": expected one of "
++ show (Set.toList expected)
-
diff --git a/src/REPL.hs b/src/REPL.hs
@@ -27,18 +27,18 @@ repl env = runInputT defaultSettings (loop env)
Just input -> do
newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
loop newEnv
-
- processInput :: Env -> String -> IO (Env)
+
+ processInput :: Env -> String -> IO Env
processInput env input = do
- let clearEnv = Map.delete "__result" env
- newEnv = evalSingle clearEnv (parseSingle input)
+ let asts = parseTricu input
+ newEnv = evalTricu env asts
case Map.lookup "__result" newEnv of
Just r -> do
putStrLn $ "tricu > " ++ show r
putStrLn $ "READ -: \"" ++ decodeResult r ++ "\""
Nothing -> return ()
return newEnv
-
+
errorHandler :: Env -> SomeException -> IO (Env)
errorHandler env e = do
putStrLn $ "Error: " ++ show e
diff --git a/src/Research.hs b/src/Research.hs
@@ -18,16 +18,6 @@ apply (Fork (Fork a1 a2) a3) Leaf = a1
apply (Fork (Fork a1 a2) a3) (Stem u) = apply a2 u
apply (Fork (Fork a1 a2) a3) (Fork u v) = apply (apply a3 u) v
-reduce :: T -> T
-reduce expr =
- let next = step expr
- in if next == expr then expr else reduce next
-
-step :: T -> T
-step (Fork left right) = reduce (apply (reduce left) (reduce right))
-step (Stem inner) = Stem (reduce inner)
-step t = t
-
-- SKI Combinators
_S :: T
_S = Fork (Stem (Fork Leaf Leaf)) Leaf
diff --git a/test.tri b/test.tri
@@ -1,2 +0,0 @@
-x = t t t
-x
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -1,12 +1,15 @@
module Main where
+import Compiler
import Eval
import Lexer
import Library
import Parser
import REPL
import Research
+
import Control.Exception (evaluate, try, SomeException)
+import Control.Monad.IO.Class (liftIO)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
@@ -28,6 +31,7 @@ tests = testGroup "Tricu Tests"
, evaluationTests
, lambdaEvalTests
, libraryTests
+ , compilerTests
, propertyTests
]
@@ -213,7 +217,7 @@ evaluationTests = testGroup "Evaluation Tests"
let input = "x = t t\nx = t\nx"
env = evalTricu Map.empty (parseTricu input)
(result env) @?= Leaf
- , testCase "Apply identity to Boolean Not" $ do
+ , testCase "Apply identity to Boolean Not" $ do
let not = "(t (t (t t) (t t t)) t)"
let input = "x = (\\a : a)\nx " ++ not
env = evalTricu Map.empty (parseTricu input)
@@ -364,7 +368,7 @@ libraryTests = testGroup "Library Tests"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Concatenate strings" $ do
- let input = "listConcat \"Hello, \" \"world!\""
+ let input = "lconcat \"Hello, \" \"world!\""
env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "Hello, world!"
, testCase "Verifying Equality" $ do
@@ -373,6 +377,19 @@ libraryTests = testGroup "Library Tests"
result env @?= Stem Leaf
]
+compilerTests :: TestTree
+compilerTests = testGroup "Compiler tests"
+ [ testCase "Forks" $ do
+ res <- liftIO $ evaluateFile "./test/fork.tri"
+ res @?= Fork Leaf Leaf
+ , testCase "File ends with comment" $ do
+ res <- liftIO $ evaluateFile "./test/comments-1.tri"
+ res @?= Fork (Stem Leaf) Leaf
+ , testCase "Mapping and Equality" $ do
+ res <- liftIO $ evaluateFile "./test/map.tri"
+ res @?= Stem Leaf
+ ]
+
propertyTests :: TestTree
propertyTests = testGroup "Property Tests"
[ testProperty "Lexing and parsing round-trip" $ \input ->
diff --git a/test/ascii.tri b/test/ascii.tri
@@ -0,0 +1 @@
+t (t (t (t (t t) (t t t)) t) t t) t
diff --git a/test/comments-1.tri b/test/comments-1.tri
@@ -0,0 +1,9 @@
+-- This is a tricu comment!
+-- t (t t) (t (t t t))
+-- t (t t t) (t t)
+-- x = (\a : a)
+t (t t) t -- Fork (Stem Leaf) Leaf
+-- t t
+-- x
+-- x = (\a : a)
+-- t
diff --git a/test/fork.tri b/test/fork.tri
@@ -0,0 +1 @@
+t t t
diff --git a/test/map.tri b/test/map.tri
@@ -0,0 +1,24 @@
+false = t
+true = t t
+_ = t
+k = t t
+i = t (t k) t
+s = t (t (k t)) t
+m = s i i
+b = s (k s) k
+c = s (s (k s) (s (k k) s)) (k k)
+iC = (\a b c : s a (k c) b)
+yi = (\i : b m (c b (i m)))
+y = yi iC
+triage = (\a b c : t (t a b) c)
+pair = t
+matchList = (\oe oc : triage oe _ oc)
+lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
+hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
+map = (\f l : hmap l f)
+lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
+lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
+equal = y (\self : triage (triage true (\z : false) (\y z : false)) (\ax : triage false (self ax) (\y z : false)) (\ax ay : triage false (\z : false) (\bx by : lAnd (self ax bx) (self ay by))))
+
+x = map (\i : lconcat "Successfully concatenated " i) [("two strings!")]
+equal x [("Successfully concatenated two strings!")]
