Compare commits
	
		
			6 Commits
		
	
	
		
			0.10.0
			...
			0.12.0-hot
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| 33c2119708 | |||
| 3b833ca75b | |||
| 203bc1898d | |||
| 87aed72ab2 | |||
| f71f88dce3 | |||
| 918d929c09 | 
| @ -54,16 +54,12 @@ jobs: | ||||
|           cp -L ./result/bin/tricu ./tricu | ||||
|           chmod 755 ./tricu | ||||
|           nix develop --command upx ./tricu | ||||
|    | ||||
|       - name: Setup go for release action | ||||
|         uses: actions/setup-go@v5 | ||||
|         with: | ||||
|           go-version: '>=1.20.1' | ||||
|    | ||||
|  | ||||
|       - name: Release binary | ||||
|         uses: https://gitea.com/actions/release-action@main | ||||
|         uses: akkuman/gitea-release-action@v1 | ||||
|         with: | ||||
|           files: |- | ||||
|             ./tricu | ||||
|           api_key: '${{ secrets.RELEASE_TOKEN }}' | ||||
|           pre_release: true | ||||
|           token: '${{ secrets.RELEASE_TOKEN }}' | ||||
|           body: '${{ gitea.event.head_commit.message }}' | ||||
|           prerelease: true | ||||
|  | ||||
| @ -10,12 +10,13 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2) | ||||
|  | ||||
| - Tree Calculus operator: `t` | ||||
| - Assignments: `x = t t` | ||||
| - Immutable definitions | ||||
| - Lambda abstraction syntax: `id = (\a : a)` | ||||
| - List, Number, and String literals: `[(2) ("Hello")]`  | ||||
| - Function application: `not (not false)` | ||||
| - Higher order/first-class functions: `map (\a : lconcat a "!") [("Hello")]` | ||||
| - Intensionality blurs the distinction between functions and data (see REPL examples) | ||||
| - Immutability | ||||
| - Simple module system for code organization | ||||
|  | ||||
| ## REPL examples | ||||
|  | ||||
| @ -44,7 +45,7 @@ tricu > 12 | ||||
|  | ||||
| [Releases are available for Linux.](https://git.eversole.co/James/tricu/releases) | ||||
|  | ||||
| Or you can easily build and/or run this project using [Nix](https://nixos.org/download/). | ||||
| Or you can easily build and run this project using [Nix](https://nixos.org/download/). | ||||
|  | ||||
| - Quick Start (REPL):  | ||||
|   - `nix run git+https://git.eversole.co/James/tricu` | ||||
| @ -71,7 +72,7 @@ tricu eval [OPTIONS] | ||||
|  | ||||
|   -f --file=FILE  Input file path(s) for evaluation. | ||||
|                     Defaults to stdin. | ||||
|   -t --form=FORM  Optional output form: (tree|fsl|ast|ternary|ascii). | ||||
|   -t --form=FORM  Optional output form: (tree|fsl|ast|ternary|ascii|decode). | ||||
|                     Defaults to tricu-compatible `t` tree form. | ||||
|  | ||||
| tricu decode [OPTIONS] | ||||
|  | ||||
| @ -1,3 +1,9 @@ | ||||
| !module Equality | ||||
|  | ||||
| !import "lib/base.tri" Lib | ||||
|  | ||||
| main = lambdaEqualsTC | ||||
|  | ||||
| -- We represent `false` with a Leaf and `true` with a Stem Leaf | ||||
| demo_false = t | ||||
| demo_true  = t t | ||||
| @ -22,7 +28,7 @@ not_Lambda? = demo_matchBool demo_false demo_true | ||||
| -- to different tree representations even if they share extensional behavior. | ||||
|  | ||||
| -- Let's see if these are the same: | ||||
| lambdaEqualsTC = equal? not_TC? not_Lambda? | ||||
| lambdaEqualsTC = Lib.equal? not_TC? not_Lambda? | ||||
|  | ||||
| -- Here are some checks to verify their extensional behavior is the same: | ||||
| true_TC?  = not_TC? demo_false | ||||
| @ -31,5 +37,5 @@ false_TC? = not_TC? demo_true | ||||
| true_Lambda?  = not_Lambda? demo_false | ||||
| false_Lambda? = not_Lambda? demo_true | ||||
|  | ||||
| bothTrueEqual?  = equal? true_TC?  true_Lambda? | ||||
| bothFalseEqual? = equal? false_TC? false_Lambda? | ||||
| bothTrueEqual?  = Lib.equal? true_TC?  true_Lambda? | ||||
| bothFalseEqual? = Lib.equal? false_TC? false_Lambda? | ||||
|  | ||||
| @ -1,3 +1,8 @@ | ||||
| !module LOT | ||||
|  | ||||
| !import "lib/base.tri" Lib | ||||
|  | ||||
| main = exampleTwo | ||||
| -- Level Order Traversal of a labelled binary tree | ||||
| -- Objective: Print each "level" of the tree on a separate line | ||||
| -- | ||||
| @ -14,41 +19,41 @@ | ||||
| --    /   /  \ | ||||
| --   4   5    6 | ||||
|  | ||||
| label = \node : head node | ||||
| label = \node : Lib.head node | ||||
|  | ||||
| left = (\node : if (emptyList? node) | ||||
| left = (\node : Lib.if (Lib.emptyList? node) | ||||
|   []  | ||||
|   (if (emptyList? (tail node))  | ||||
|   (Lib.if (Lib.emptyList? (Lib.tail node))  | ||||
|     []  | ||||
|     (head (tail node)))) | ||||
|     (Lib.head (Lib.tail node)))) | ||||
|  | ||||
| right = (\node : if (emptyList? node)  | ||||
| right = (\node : Lib.if (Lib.emptyList? node)  | ||||
|   []  | ||||
|   (if (emptyList? (tail node))  | ||||
|   (Lib.if (Lib.emptyList? (Lib.tail node))  | ||||
|     []  | ||||
|     (if (emptyList? (tail (tail node)))  | ||||
|     (Lib.if (Lib.emptyList? (Lib.tail (Lib.tail node)))  | ||||
|       []  | ||||
|       (head (tail (tail node)))))) | ||||
|       (Lib.head (Lib.tail (Lib.tail node)))))) | ||||
|  | ||||
| processLevel = y (\self queue : if (emptyList? queue)  | ||||
| processLevel = Lib.y (\self queue : Lib.if (Lib.emptyList? queue)  | ||||
|   []  | ||||
|   (pair (map label queue) (self (filter  | ||||
|     (\node : not? (emptyList? node))  | ||||
|       (lconcat (map left queue) (map right queue)))))) | ||||
|   (Lib.pair (Lib.map label queue) (self (Lib.filter  | ||||
|     (\node : Lib.not? (Lib.emptyList? node))  | ||||
|       (Lib.lconcat (Lib.map left queue) (Lib.map right queue)))))) | ||||
|  | ||||
| levelOrderTraversal_ = \a : processLevel (t a t) | ||||
|  | ||||
| toLineString = y (\self levels : if (emptyList? levels)  | ||||
| toLineString = Lib.y (\self levels : Lib.if (Lib.emptyList? levels)  | ||||
|   ""  | ||||
|   (lconcat  | ||||
|     (lconcat (map (\x : lconcat x " ") (head levels)) "")  | ||||
|     (if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels)))))) | ||||
|   (Lib.lconcat  | ||||
|     (Lib.lconcat (Lib.map (\x : Lib.lconcat x " ") (Lib.head levels)) "")  | ||||
|     (Lib.if (Lib.emptyList? (Lib.tail levels)) "" (Lib.lconcat (t (t 10 t) t) (self (Lib.tail levels)))))) | ||||
|  | ||||
| levelOrderToString = \s : toLineString (levelOrderTraversal_ s) | ||||
|  | ||||
| flatten = foldl (\acc x : lconcat acc x) "" | ||||
| flatten = Lib.foldl (\acc x : Lib.lconcat acc x) "" | ||||
|  | ||||
| levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s)) | ||||
| levelOrderTraversal = \s : Lib.lconcat (t 10 t) (flatten (levelOrderToString s)) | ||||
|  | ||||
| exampleOne = levelOrderTraversal [("1")  | ||||
|                                  [("2") [("4") t t] t]  | ||||
| @ -58,5 +63,3 @@ exampleTwo = levelOrderTraversal [("1") | ||||
|                                  [("2") [("4") [("8") t t] [("9") t t]]  | ||||
|                                         [("6") [("10") t t] [("12") t t]]]  | ||||
|                                  [("3") [("5") [("11") t t] t] [("7") t t]]] | ||||
|  | ||||
| exampleTwo | ||||
|  | ||||
| @ -1,21 +1,25 @@ | ||||
| !module Size | ||||
|  | ||||
| !import "lib/base.tri" Lib | ||||
|  | ||||
| main = size size | ||||
|  | ||||
| compose = \f g x : f (g x) | ||||
|  | ||||
| succ = y (\self : | ||||
|   triage | ||||
| succ = Lib.y (\self : | ||||
|   Lib.triage | ||||
|     1 | ||||
|     t | ||||
|     (triage | ||||
|     (Lib.triage | ||||
|       (t (t t)) | ||||
|       (\_ tail : t t (self tail)) | ||||
|       (\_ Lib.tail : t t (self Lib.tail)) | ||||
|       t)) | ||||
|  | ||||
| size = (\x : | ||||
|   (y (\self x : | ||||
|   (Lib.y (\self x : | ||||
|     compose succ | ||||
|       (triage | ||||
|       (Lib.triage | ||||
|         (\x : x) | ||||
|         self | ||||
|         (\x y : compose (self x) (self y)) | ||||
|         x)) x 0)) | ||||
|  | ||||
| size size | ||||
|  | ||||
| @ -1,3 +1,8 @@ | ||||
| !module ToSource | ||||
|  | ||||
| !import "lib/base.tri" Lib | ||||
|  | ||||
| main = toSource Lib.not? | ||||
| -- Thanks to intensionality, we can inspect the structure of a given value | ||||
| -- even if it's a function. This includes lambdas which are eliminated to | ||||
| -- Tree Calculus (TC) terms during evaluation. | ||||
| @ -11,29 +16,29 @@ | ||||
| -- triage = (\leaf stem fork : t (t leaf stem) fork) | ||||
|  | ||||
| -- Base case of a single Leaf | ||||
| sourceLeaf = t (head "t") | ||||
| sourceLeaf = t (Lib.head "t") | ||||
|  | ||||
| -- Stem case | ||||
| sourceStem = (\convert : (\a rest : | ||||
|   t (head "(")                       -- Start with a left parenthesis "(". | ||||
|     (t (head "t")                    -- Add a "t" | ||||
|       (t (head " ")                  -- Add a space. | ||||
|         (convert a                   -- Recursively convert the argument. | ||||
|           (t (head ")") rest))))))   -- Close with ")" and append the rest. | ||||
|   t (Lib.head "(")                       -- Start with a left parenthesis "(". | ||||
|     (t (Lib.head "t")                    -- Add a "t" | ||||
|       (t (Lib.head " ")                  -- Add a space. | ||||
|         (convert a                       -- Recursively convert the argument. | ||||
|           (t (Lib.head ")") rest))))))   -- Close with ")" and append the rest. | ||||
|  | ||||
| -- Fork case | ||||
| sourceFork = (\convert : (\a b rest : | ||||
|   t (head "(")                           -- Start with a left parenthesis "(". | ||||
|     (t (head "t")                        -- Add a "t" | ||||
|       (t (head " ")                      -- Add a space. | ||||
|         (convert a                       -- Recursively convert the first arg. | ||||
|           (t (head " ")                  -- Add another space. | ||||
|             (convert b                   -- Recursively convert the second arg. | ||||
|               (t (head ")") rest)))))))) -- Close with ")" and append the rest. | ||||
|   t (Lib.head "(")                           -- Start with a left parenthesis "(". | ||||
|     (t (Lib.head "t")                        -- Add a "t" | ||||
|       (t (Lib.head " ")                      -- Add a space. | ||||
|         (convert a                           -- Recursively convert the first arg. | ||||
|           (t (Lib.head " ")                  -- Add another space. | ||||
|             (convert b                       -- Recursively convert the second arg. | ||||
|               (t (Lib.head ")") rest)))))))) -- Close with ")" and append the rest. | ||||
|  | ||||
| -- Wrapper around triage  | ||||
| toSource_ = y (\self arg : | ||||
|   triage | ||||
| toSource_ = Lib.y (\self arg : | ||||
|   Lib.triage | ||||
|     sourceLeaf        -- `triage` "a" case, Leaf | ||||
|     (sourceStem self) -- `triage` "b" case, Stem | ||||
|     (sourceFork self) -- `triage` "c" case, Fork | ||||
| @ -42,5 +47,5 @@ toSource_ = y (\self arg : | ||||
| -- toSource takes a single TC term and returns a String | ||||
| toSource = \v : toSource_ v "" | ||||
|  | ||||
| exampleOne = toSource true -- OUT: "(t t)" | ||||
| exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))" | ||||
| exampleOne = toSource Lib.true -- OUT: "(t t)" | ||||
| exampleTwo = toSource Lib.not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))" | ||||
|  | ||||
							
								
								
									
										102
									
								
								src/Eval.hs
									
									
									
									
									
								
							
							
						
						
									
										102
									
								
								src/Eval.hs
									
									
									
									
									
								
							| @ -3,33 +3,33 @@ module Eval where | ||||
| import Parser | ||||
| import Research | ||||
|  | ||||
| import Data.List (partition) | ||||
| import Data.List (partition, (\\)) | ||||
| import Data.Map  (Map) | ||||
| import qualified Data.Map as Map | ||||
| import qualified Data.Set as Set | ||||
|  | ||||
| evalSingle :: Env -> TricuAST -> Env | ||||
| evalSingle env term | ||||
|   | SDef name [] body <- term = | ||||
|       if | ||||
|         | Map.member name env -> | ||||
|             errorWithoutStackTrace $ | ||||
|               "Error: Identifier '" ++ name ++ "' is already defined." | ||||
|         | otherwise -> | ||||
|             let res = evalAST env body | ||||
|             in Map.insert "__result" res (Map.insert name res env) | ||||
|   | SApp func arg <- term = | ||||
|       let res = apply (evalAST env func) (evalAST env arg) | ||||
|       in Map.insert "__result" res env | ||||
|   | SVar name <- term = | ||||
|       case Map.lookup name env of | ||||
|         Just v  -> | ||||
|           Map.insert "__result" v env | ||||
|   | SDef name [] body <- term | ||||
|   = case Map.lookup name env of | ||||
|       Just existingValue | ||||
|         | existingValue == evalAST env body -> env | ||||
|         | otherwise -> errorWithoutStackTrace $ | ||||
|             "Unable to rebind immutable identifier: '" ++ name | ||||
|       Nothing -> | ||||
|         let res = evalAST env body | ||||
|         in Map.insert "!result" res (Map.insert name res env) | ||||
|   | SApp func arg <- term  | ||||
|   = let res = apply (evalAST env func) (evalAST env arg) | ||||
|       in Map.insert "!result" res env | ||||
|   | SVar name <- term  | ||||
|   = case Map.lookup name env of | ||||
|         Just v  -> Map.insert "!result" v env | ||||
|         Nothing -> | ||||
|           errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined\n\ | ||||
|           \This error should never occur here. Please report this as an issue." | ||||
|   | otherwise = | ||||
|       Map.insert "__result" (evalAST env term) env | ||||
|   | otherwise  | ||||
|   = Map.insert "!result" (evalAST env term) env | ||||
|  | ||||
| evalTricu :: Env -> [TricuAST] -> Env | ||||
| evalTricu env x = go env (reorderDefs env x) | ||||
| @ -37,7 +37,7 @@ evalTricu env x = go env (reorderDefs env x) | ||||
|     go env []     = env | ||||
|     go env [x]    = | ||||
|       let updatedEnv = evalSingle env x | ||||
|       in Map.insert "__result" (result updatedEnv) updatedEnv | ||||
|       in Map.insert "!result" (result updatedEnv) updatedEnv | ||||
|     go env (x:xs) = | ||||
|       evalTricu (evalSingle env x) xs | ||||
|  | ||||
| @ -109,10 +109,11 @@ freeVars (SStr    _    ) = Set.empty | ||||
| freeVars (SList   s    ) = foldMap freeVars s | ||||
| freeVars (SApp    f a  ) = freeVars f <> freeVars a | ||||
| freeVars (TLeaf        ) = Set.empty | ||||
| freeVars (SDef   _ _ b) = freeVars b | ||||
| freeVars (SDef   _ _ b)  = freeVars b | ||||
| freeVars (TStem   t    ) = freeVars t | ||||
| freeVars (TFork   l r  ) = freeVars l <> freeVars r | ||||
| freeVars (SLambda v b  ) = foldr Set.delete (freeVars b) v | ||||
| freeVars _               = Set.empty | ||||
|  | ||||
| reorderDefs :: Env -> [TricuAST] -> [TricuAST] | ||||
| reorderDefs env defs | ||||
| @ -122,17 +123,20 @@ reorderDefs env defs | ||||
|   | otherwise = orderedDefs ++ others | ||||
|   where | ||||
|     (defsOnly, others) = partition isDef defs | ||||
|     graph              = buildDepGraph defsOnly | ||||
|     sortedDefs         = sortDeps graph | ||||
|     defMap             = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly] | ||||
|     orderedDefs        = map (\name -> defMap Map.! name) sortedDefs | ||||
|     topDefNames        = Set.fromList (Map.keys defMap) | ||||
|     envNames           = Set.fromList (Map.keys env) | ||||
|     freeVarsDefs       = foldMap (\(SDef _ _ body) -> freeVars body) defsOnly | ||||
|     freeVarsOthers     = foldMap freeVars others | ||||
|     allFreeVars        = freeVarsDefs <> freeVarsOthers | ||||
|     validNames         = topDefNames `Set.union` envNames | ||||
|     missingDeps        = Set.toList (allFreeVars `Set.difference` validNames) | ||||
|     defNames = [ name | SDef name _ _ <- defsOnly ] | ||||
|  | ||||
|     defsWithFreeVars = [(def, freeVars body) | def@(SDef _ _ body) <- defsOnly] | ||||
|  | ||||
|     graph = buildDepGraph defsOnly | ||||
|     sortedDefs = sortDeps graph | ||||
|     defMap = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly] | ||||
|     orderedDefs = map (\name -> defMap Map.! name) sortedDefs | ||||
|  | ||||
|     freeVarsDefs = foldMap snd defsWithFreeVars | ||||
|     freeVarsOthers = foldMap freeVars others | ||||
|     allFreeVars = freeVarsDefs <> freeVarsOthers | ||||
|     validNames = Set.fromList defNames `Set.union` Set.fromList (Map.keys env) | ||||
|     missingDeps = Set.toList (allFreeVars `Set.difference` validNames) | ||||
|  | ||||
|     isDef (SDef _ _ _) = True | ||||
|     isDef _            = False | ||||
| @ -153,20 +157,21 @@ buildDepGraph topDefs | ||||
|     countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty | ||||
|  | ||||
| sortDeps :: Map.Map String (Set.Set String) -> [String] | ||||
| sortDeps graph = go [] (Map.keys graph) | ||||
| sortDeps graph = go [] Set.empty (Map.keys graph) | ||||
|   where | ||||
|     go sorted [] = sorted | ||||
|     go sorted remaining | ||||
|       | null ready = | ||||
|           errorWithoutStackTrace | ||||
|             "ERROR: Top-level cyclic dependency detected and prohibited\n\ | ||||
|            \RESOLVE: Use nested lambdas" | ||||
|       | otherwise = go (sorted ++ ready) notReady | ||||
|       where | ||||
|         ready    = [ name | name <- remaining | ||||
|                     , all (`elem` sorted) (Set.toList (graph Map.! name))] | ||||
|         notReady = | ||||
|           [ name | name <- remaining , name `notElem` ready] | ||||
|     go sorted sortedSet [] = sorted | ||||
|     go sorted sortedSet remaining = | ||||
|       let ready = [ name | name <- remaining | ||||
|                         , let deps = Map.findWithDefault Set.empty name graph | ||||
|                         , Set.isSubsetOf deps sortedSet ] | ||||
|           notReady = remaining \\ ready | ||||
|       in if null ready | ||||
|          then errorWithoutStackTrace | ||||
|           "ERROR: Cyclic dependency detected and prohibited.\n\ | ||||
|           \RESOLVE: Use nested lambdas." | ||||
|          else go (sorted ++ ready) | ||||
|                  (Set.union sortedSet (Set.fromList ready)) | ||||
|                  notReady | ||||
|  | ||||
| depends :: [TricuAST] -> TricuAST -> Set.Set String | ||||
| depends topDefs (SDef _ _ body) = | ||||
| @ -176,6 +181,11 @@ depends topDefs (SDef _ _ body) = | ||||
| depends _ _ = Set.empty | ||||
|  | ||||
| result :: Env -> T | ||||
| result r = case Map.lookup "__result" r of | ||||
| result r = case Map.lookup "!result" r of | ||||
|   Just a -> a | ||||
|   Nothing -> errorWithoutStackTrace "No __result field found in provided env" | ||||
|   Nothing -> errorWithoutStackTrace "No !result field found in provided env" | ||||
|  | ||||
| mainResult :: Env -> T | ||||
| mainResult r = case Map.lookup "main" r of | ||||
|   Just  a -> a | ||||
|   Nothing -> errorWithoutStackTrace "No valid definition for `main` found." | ||||
|  | ||||
							
								
								
									
										138
									
								
								src/FileEval.hs
									
									
									
									
									
								
							
							
						
						
									
										138
									
								
								src/FileEval.hs
									
									
									
									
									
								
							| @ -1,30 +1,150 @@ | ||||
| module FileEval where | ||||
|  | ||||
| import Eval | ||||
| import Lexer | ||||
| import Parser | ||||
| import Research | ||||
|  | ||||
| import Data.List       (partition) | ||||
| import Control.Monad   (foldM) | ||||
| import System.IO | ||||
|  | ||||
| import qualified Data.Map as Map | ||||
| import qualified Data.Set as Set | ||||
|  | ||||
| evaluateFileResult :: FilePath -> IO T | ||||
| evaluateFileResult filePath = do | ||||
|   contents <- readFile filePath | ||||
|   let asts = parseTricu contents | ||||
|   let finalEnv = evalTricu Map.empty asts | ||||
|   case Map.lookup "__result" finalEnv of | ||||
|     Just finalResult -> return finalResult | ||||
|     Nothing -> errorWithoutStackTrace "No expressions to evaluate found" | ||||
|   let tokens = lexTricu contents | ||||
|   let moduleName = case parseProgram tokens of | ||||
|         Right ((SModule name) : _) -> name | ||||
|         _                          -> "" | ||||
|   case parseProgram tokens of | ||||
|     Left err -> errorWithoutStackTrace (handleParseError err) | ||||
|     Right _ -> do | ||||
|       ast <- preprocessFile filePath | ||||
|       let finalEnv = mainAlias moduleName $ evalTricu Map.empty ast | ||||
|       case Map.lookup "main" finalEnv of | ||||
|         Just finalResult -> return finalResult | ||||
|         Nothing -> errorWithoutStackTrace "No `main` function detected" | ||||
|  | ||||
| evaluateFile :: FilePath -> IO Env | ||||
| evaluateFile filePath = do | ||||
|   contents <- readFile filePath | ||||
|   let asts = parseTricu contents | ||||
|   pure $ evalTricu Map.empty asts | ||||
|   let tokens = lexTricu contents | ||||
|   let moduleName = case parseProgram tokens of | ||||
|         Right ((SModule name) : _) -> name | ||||
|         _                          -> "" | ||||
|   case parseProgram tokens of | ||||
|     Left err -> errorWithoutStackTrace (handleParseError err) | ||||
|     Right _ -> do | ||||
|       ast <- preprocessFile filePath | ||||
|       pure $ mainAlias moduleName $ evalTricu Map.empty ast | ||||
|  | ||||
| evaluateFileWithContext :: Env -> FilePath -> IO Env | ||||
| evaluateFileWithContext env filePath = do | ||||
|   contents <- readFile filePath | ||||
|   let asts = parseTricu contents | ||||
|   pure $ evalTricu env asts | ||||
|   let tokens = lexTricu contents | ||||
|   let moduleName = case parseProgram tokens of | ||||
|         Right ((SModule name) : _) -> name | ||||
|         _                          -> "" | ||||
|   case parseProgram tokens of | ||||
|     Left err -> errorWithoutStackTrace (handleParseError err) | ||||
|     Right _ -> do | ||||
|       ast <- preprocessFile filePath | ||||
|       pure $ mainAlias moduleName $ evalTricu env ast | ||||
|  | ||||
| mainAlias :: String -> Env -> Env | ||||
| mainAlias "" env = env | ||||
| mainAlias moduleName env = | ||||
|   case Map.lookup (moduleName ++ ".main") env of | ||||
|     Just value -> Map.insert "main" value env | ||||
|     Nothing    -> env | ||||
|  | ||||
| preprocessFile :: FilePath -> IO [TricuAST] | ||||
| preprocessFile filePath = preprocessFile' Set.empty filePath | ||||
|  | ||||
| preprocessFile' :: Set.Set FilePath -> FilePath -> IO [TricuAST] | ||||
| preprocessFile' inProgress filePath | ||||
|   | filePath `Set.member` inProgress =  | ||||
|       errorWithoutStackTrace $ "Encountered cyclic import: " ++ filePath | ||||
|   | otherwise = do | ||||
|       contents <- readFile filePath | ||||
|       let tokens = lexTricu contents | ||||
|       case parseProgram tokens of | ||||
|         Left err -> errorWithoutStackTrace (handleParseError err) | ||||
|         Right asts -> do | ||||
|           let (moduleName, restAST) = extractModule asts | ||||
|           let (imports, nonImports) = partition isImport restAST | ||||
|           let newInProgress = Set.insert filePath inProgress | ||||
|           importedASTs <- concat <$> mapM (processImport newInProgress) imports | ||||
|           let namespacedAST = namespaceDefinitions moduleName nonImports | ||||
|           pure $ importedASTs ++ namespacedAST | ||||
|   where | ||||
|     extractModule :: [TricuAST] -> (String, [TricuAST]) | ||||
|     extractModule ((SModule name) : xs) = (name, xs) | ||||
|     extractModule xs                    = ("", xs) | ||||
|  | ||||
|     isImport :: TricuAST -> Bool | ||||
|     isImport (SImport _ _) = True | ||||
|     isImport _             = False | ||||
|  | ||||
|     processImport :: Set.Set FilePath -> TricuAST -> IO [TricuAST] | ||||
|     processImport inProgress (SImport filePath moduleName) = do | ||||
|       importedAST <- preprocessFile' inProgress filePath | ||||
|       pure $ namespaceDefinitions moduleName importedAST | ||||
|     processImport _ _ = error "Unexpected non-import in processImport" | ||||
|  | ||||
| namespaceDefinitions :: String -> [TricuAST] -> [TricuAST] | ||||
| namespaceDefinitions moduleName = map (namespaceDefinition moduleName) | ||||
|  | ||||
| namespaceDefinition :: String -> TricuAST -> TricuAST | ||||
| namespaceDefinition "" def = def | ||||
| namespaceDefinition moduleName (SDef name args body) | ||||
|   | isPrefixed name = SDef name args (namespaceBody moduleName body) | ||||
|   | otherwise = SDef (namespaceVariable moduleName name)  | ||||
|                         args (namespaceBody moduleName body) | ||||
| namespaceDefinition moduleName other = | ||||
|   namespaceBody moduleName other | ||||
|  | ||||
| namespaceBody :: String -> TricuAST -> TricuAST | ||||
| namespaceBody moduleName (SVar name) | ||||
|   | isPrefixed name = SVar name | ||||
|   | otherwise = SVar (namespaceVariable moduleName name) | ||||
| namespaceBody moduleName (SApp func arg) = | ||||
|   SApp (namespaceBody moduleName func) (namespaceBody moduleName arg) | ||||
| namespaceBody moduleName (SLambda args body) = | ||||
|   SLambda args (namespaceBodyScoped moduleName args body) | ||||
| namespaceBody moduleName (SList items) = | ||||
|   SList (map (namespaceBody moduleName) items) | ||||
| namespaceBody moduleName (TFork left right) = | ||||
|   TFork (namespaceBody moduleName left) (namespaceBody moduleName right) | ||||
| namespaceBody moduleName (TStem subtree) = | ||||
|   TStem (namespaceBody moduleName subtree) | ||||
| namespaceBody moduleName (SDef name args body) | ||||
|   | isPrefixed name = SDef name args (namespaceBody moduleName body) | ||||
|   | otherwise = SDef (namespaceVariable moduleName name)  | ||||
|                         args (namespaceBody moduleName body) | ||||
| namespaceBody _ other = other | ||||
|  | ||||
| namespaceBodyScoped :: String -> [String] -> TricuAST -> TricuAST | ||||
| namespaceBodyScoped moduleName args body = case body of | ||||
|   SVar name -> | ||||
|     if name `elem` args | ||||
|       then SVar name | ||||
|       else namespaceBody moduleName (SVar name) | ||||
|   SApp func arg -> SApp (namespaceBodyScoped moduleName args func) (namespaceBodyScoped moduleName args arg) | ||||
|   SLambda innerArgs innerBody -> SLambda innerArgs (namespaceBodyScoped moduleName (args ++ innerArgs) innerBody) | ||||
|   SList items -> SList (map (namespaceBodyScoped moduleName args) items) | ||||
|   TFork left right -> TFork (namespaceBodyScoped moduleName args left) (namespaceBodyScoped moduleName args right) | ||||
|   TStem subtree -> TStem (namespaceBodyScoped moduleName args subtree) | ||||
|   SDef name innerArgs innerBody -> | ||||
|     SDef (namespaceVariable moduleName name) innerArgs (namespaceBodyScoped moduleName (args ++ innerArgs) innerBody) | ||||
|   other -> other | ||||
|  | ||||
| isPrefixed :: String -> Bool | ||||
| isPrefixed name = '.' `elem` name | ||||
|  | ||||
| namespaceVariable :: String -> String -> String | ||||
| namespaceVariable "" name = name | ||||
| namespaceVariable moduleName name = moduleName ++ "." ++ name | ||||
|  | ||||
							
								
								
									
										62
									
								
								src/Lexer.hs
									
									
									
									
									
								
							
							
						
						
									
										62
									
								
								src/Lexer.hs
									
									
									
									
									
								
							| @ -20,11 +20,11 @@ identifier = do | ||||
|   first <- letterChar <|> char '_' | ||||
|   rest  <- many $ letterChar  | ||||
|               <|> digitChar  | ||||
|               <|> char '_' <|> char '-' <|> char '?' <|> char '!' | ||||
|               <|> char '_' <|> char '-' <|> char '?' <|> char '.' | ||||
|               <|> char '$' <|> char '#' <|> char '@' <|> char '%' | ||||
|   let name = first : rest | ||||
|   if (name == "t" || name == "__result") | ||||
|     then fail "Keywords (`t`, `__result`) cannot be used as an identifier" | ||||
|   if (name == "t" || name == "!result") | ||||
|     then fail "Keywords (`t`, `!result`) cannot be used as an identifier" | ||||
|     else return (LIdentifier name) | ||||
|  | ||||
| integerLiteral :: Lexer LToken | ||||
| @ -39,6 +39,22 @@ stringLiteral = do | ||||
|   char '"' --" | ||||
|   return (LStringLiteral content) | ||||
|  | ||||
| lModule :: Lexer LToken | ||||
| lModule = do | ||||
|   _ <- string "!module" | ||||
|   space1 | ||||
|   LIdentifier moduleName <- identifier | ||||
|   return (LModule moduleName) | ||||
|  | ||||
| lImport :: Lexer LToken | ||||
| lImport = do | ||||
|   _ <- string "!import" | ||||
|   space1 | ||||
|   LStringLiteral path <- stringLiteral | ||||
|   space1 | ||||
|   LIdentifier name <- identifier | ||||
|   return (LImport path name) | ||||
|  | ||||
| assign :: Lexer LToken | ||||
| assign = char '=' *> pure LAssign | ||||
|  | ||||
| @ -72,28 +88,36 @@ sc = space | ||||
| tricuLexer :: Lexer [LToken] | ||||
| tricuLexer = do | ||||
|   sc | ||||
|   header <- many $ do | ||||
|     tok <- choice | ||||
|       [ try lModule | ||||
|       , try lImport | ||||
|       , lnewline | ||||
|       ] | ||||
|     sc | ||||
|     pure tok | ||||
|   tokens <- many $ do | ||||
|     tok <- choice tricuLexer' | ||||
|     sc | ||||
|     pure tok | ||||
|   sc | ||||
|   eof | ||||
|   pure tokens | ||||
|     where | ||||
|       tricuLexer' =  | ||||
|         [ try lnewline | ||||
|         , try identifier | ||||
|         , try keywordT | ||||
|         , try integerLiteral | ||||
|         , try stringLiteral | ||||
|         , assign | ||||
|         , colon | ||||
|         , backslash | ||||
|         , openParen | ||||
|         , closeParen | ||||
|         , openBracket | ||||
|         , closeBracket | ||||
|         ] | ||||
|   pure (header ++ tokens) | ||||
|   where | ||||
|     tricuLexer' = | ||||
|       [ try lnewline | ||||
|       , try identifier | ||||
|       , try keywordT | ||||
|       , try integerLiteral | ||||
|       , try stringLiteral | ||||
|       , assign | ||||
|       , colon | ||||
|       , backslash | ||||
|       , openParen | ||||
|       , closeParen | ||||
|       , openBracket | ||||
|       , closeBracket | ||||
|       ] | ||||
|  | ||||
| lexTricu :: String -> [LToken] | ||||
| lexTricu input = case runParser tricuLexer "" input of | ||||
|  | ||||
							
								
								
									
										18
									
								
								src/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										18
									
								
								src/Main.hs
									
									
									
									
									
								
							| @ -1,6 +1,6 @@ | ||||
| module Main where | ||||
|  | ||||
| import Eval                   (evalTricu, result) | ||||
| import Eval                   (evalTricu, mainResult, result) | ||||
| import FileEval | ||||
| import Parser                 (parseTricu) | ||||
| import REPL | ||||
| @ -16,7 +16,7 @@ import qualified Data.Map as Map | ||||
| data TricuArgs | ||||
|   = Repl | ||||
|   | Evaluate { file :: [FilePath], form :: EvaluatedForm } | ||||
|   | Decode { file :: [FilePath] } | ||||
|   | TDecode { file :: [FilePath] } | ||||
|   deriving (Show, Data, Typeable) | ||||
|  | ||||
| replMode :: TricuArgs | ||||
| @ -31,7 +31,7 @@ evaluateMode = Evaluate | ||||
|       \ Defaults to stdin." | ||||
|       &= name "f" &= typ "FILE" | ||||
|     , form = TreeCalculus &= typ "FORM" | ||||
|       &= help "Optional output form: (tree|fsl|ast|ternary|ascii).\n \ | ||||
|       &= help "Optional output form: (tree|fsl|ast|ternary|ascii|decode).\n \ | ||||
|       \ Defaults to tricu-compatible `t` tree form." | ||||
|       &= name "t" | ||||
|   } | ||||
| @ -40,7 +40,7 @@ evaluateMode = Evaluate | ||||
|   &= name "eval" | ||||
|  | ||||
| decodeMode :: TricuArgs | ||||
| decodeMode = Decode | ||||
| decodeMode = TDecode | ||||
|   { file = def | ||||
|     &= help "Optional input file path to attempt decoding.\n \ | ||||
|     \ Defaults to stdin." | ||||
| @ -60,8 +60,7 @@ main = do | ||||
|     Repl -> do | ||||
|       putStrLn "Welcome to the tricu REPL" | ||||
|       putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`" | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       repl $ Map.delete "__result" library | ||||
|       repl Map.empty | ||||
|     Evaluate { file = filePaths, form = form } -> do | ||||
|       result <- case filePaths of | ||||
|         [] -> do | ||||
| @ -70,15 +69,14 @@ main = do | ||||
|         (filePath:restFilePaths) -> do | ||||
|             initialEnv <- evaluateFile filePath | ||||
|             finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths | ||||
|             pure $ result finalEnv | ||||
|             pure $ mainResult finalEnv | ||||
|       let fRes = formatResult form result | ||||
|       putStr fRes | ||||
|     Decode { file = filePaths } -> do | ||||
|     TDecode { file = filePaths } -> do | ||||
|       value <- case filePaths of | ||||
|         [] -> getContents | ||||
|         (filePath:_) -> readFile filePath | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value | ||||
|       putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value | ||||
|  | ||||
| runTricu :: String -> T | ||||
| runTricu input = | ||||
|  | ||||
| @ -74,9 +74,33 @@ parseSingle input = | ||||
| parseProgramM :: ParserM [TricuAST] | ||||
| parseProgramM = do | ||||
|   skipMany topLevelNewline | ||||
|   moduleNode <- optional parseModuleM | ||||
|   skipMany topLevelNewline | ||||
|   importNodes <- many (do | ||||
|     node <- parseImportM | ||||
|     skipMany topLevelNewline | ||||
|     return node) | ||||
|   skipMany topLevelNewline | ||||
|   exprs <- sepEndBy parseOneExpression (some topLevelNewline) | ||||
|   skipMany topLevelNewline | ||||
|   return exprs | ||||
|   return (maybe [] (: []) moduleNode ++ importNodes ++ exprs) | ||||
|  | ||||
|  | ||||
| parseModuleM :: ParserM TricuAST | ||||
| parseModuleM = do | ||||
|   LModule moduleName <- satisfyM isModule | ||||
|   pure (SModule moduleName) | ||||
|   where | ||||
|     isModule (LModule _) = True | ||||
|     isModule _           = False | ||||
|  | ||||
| parseImportM :: ParserM TricuAST | ||||
| parseImportM = do | ||||
|   LImport filePath moduleName <- satisfyM isImport | ||||
|   pure (SImport filePath moduleName) | ||||
|   where | ||||
|     isImport (LImport _ _) = True | ||||
|     isImport _             = False | ||||
|  | ||||
| parseOneExpression :: ParserM TricuAST | ||||
| parseOneExpression = scnParserM *> parseExpressionM | ||||
| @ -244,7 +268,7 @@ parseVarM :: ParserM TricuAST | ||||
| parseVarM = do | ||||
|   satisfyM (\case LIdentifier _ -> True; _ -> False) >>= \case | ||||
|     LIdentifier name | ||||
|       | name == "t" || name == "__result" -> | ||||
|       | name == "t" || name == "!result" -> | ||||
|         fail ("Reserved keyword: " ++ name ++ " cannot be assigned.") | ||||
|       | otherwise                         -> | ||||
|          pure (SVar name) | ||||
|  | ||||
							
								
								
									
										13
									
								
								src/REPL.hs
									
									
									
									
									
								
							
							
						
						
									
										13
									
								
								src/REPL.hs
									
									
									
									
									
								
							| @ -26,7 +26,7 @@ repl env = runInputT defaultSettings (loop env) | ||||
|         | Just s  <- minput, strip s == ""      -> do | ||||
|           outputStrLn "" | ||||
|           loop env | ||||
|         | Just s  <- minput, strip s == "!load" -> do | ||||
|         | Just s  <- minput, strip s == "!import" -> do | ||||
|           path <- getInputLine "File path to load < " | ||||
|           if | ||||
|             | Nothing <- path -> do | ||||
| @ -34,7 +34,7 @@ repl env = runInputT defaultSettings (loop env) | ||||
|               loop env | ||||
|             | Just p  <- path -> do | ||||
|               loadedEnv <- liftIO $ evaluateFileWithContext env (strip p) `catch` \e -> errorHandler env e | ||||
|               loop $ Map.delete "__result" (Map.union loadedEnv env) | ||||
|               loop $ Map.delete "!result" (Map.union loadedEnv env) | ||||
|         | Just s <- minput -> do | ||||
|           if | ||||
|             | take 2 s == "--" -> loop env | ||||
| @ -47,7 +47,7 @@ repl env = runInputT defaultSettings (loop env) | ||||
|       let asts   = parseTricu input | ||||
|           newEnv = evalTricu env asts | ||||
|       if | ||||
|         | Just r <- Map.lookup "__result" newEnv -> do | ||||
|         | Just r <- Map.lookup "!result" newEnv -> do | ||||
|           putStrLn $ "tricu > " ++ decodeResult r | ||||
|         | otherwise -> return () | ||||
|       return newEnv | ||||
| @ -59,10 +59,3 @@ repl env = runInputT defaultSettings (loop env) | ||||
|      | ||||
|     strip :: String -> String | ||||
|     strip = dropWhileEnd isSpace . dropWhile isSpace | ||||
|  | ||||
| decodeResult :: T -> String | ||||
| decodeResult tc | ||||
|   | Right num  <- toNumber tc = show num | ||||
|   | Right str  <- toString tc = "\"" ++ str ++ "\"" | ||||
|   | Right list <- toList tc   = "[" ++ intercalate ", " (map decodeResult list) ++ "]" | ||||
|   | otherwise                 = formatResult TreeCalculus tc | ||||
|  | ||||
| @ -26,6 +26,8 @@ data TricuAST | ||||
|   | TFork TricuAST TricuAST | ||||
|   | SLambda [String] TricuAST | ||||
|   | SEmpty | ||||
|   | SModule String | ||||
|   | SImport String String | ||||
|   deriving (Show, Eq, Ord) | ||||
|  | ||||
| -- Lexer Tokens | ||||
| @ -42,10 +44,12 @@ data LToken | ||||
|   | LOpenBracket | ||||
|   | LCloseBracket | ||||
|   | LNewline | ||||
|   | LModule String | ||||
|   | LImport String String | ||||
|   deriving (Show, Eq, Ord) | ||||
|  | ||||
| -- Output formats | ||||
| data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | ||||
| data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode | ||||
|   deriving (Show, Data, Typeable) | ||||
|  | ||||
| -- Environment containing previously evaluated TC terms | ||||
| @ -115,6 +119,7 @@ formatResult FSL          = show | ||||
| formatResult AST          = show . toAST | ||||
| formatResult Ternary      = toTernaryString | ||||
| formatResult Ascii        = toAscii | ||||
| formatResult Decode       = decodeResult | ||||
|  | ||||
| toSimpleT :: String -> String | ||||
| toSimpleT s = T.unpack  | ||||
| @ -147,4 +152,9 @@ toAscii tree = go tree "" True | ||||
|         ++ go left (prefix ++ (if isLast then "    " else "|   ")) False | ||||
|         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True | ||||
|  | ||||
| -- Utility | ||||
| decodeResult :: T -> String | ||||
| decodeResult tc | ||||
|   | Right num  <- toNumber tc = show num | ||||
|   | Right str  <- toString tc = "\"" ++ str ++ "\"" | ||||
|   | Right list <- toList tc   = "[" ++ intercalate ", " (map decodeResult list) ++ "]" | ||||
|   | otherwise                 = formatResult TreeCalculus tc | ||||
|  | ||||
							
								
								
									
										71
									
								
								test/Spec.hs
									
									
									
									
									
								
							
							
						
						
									
										71
									
								
								test/Spec.hs
									
									
									
									
									
								
							| @ -7,12 +7,13 @@ import Parser | ||||
| import REPL | ||||
| import Research | ||||
|  | ||||
| import Control.Exception (evaluate, try, SomeException) | ||||
| import Control.Exception      (evaluate, try, SomeException) | ||||
| import Control.Monad.IO.Class (liftIO) | ||||
| import Data.List              (isInfixOf) | ||||
| import Test.Tasty | ||||
| import Test.Tasty.HUnit | ||||
| import Test.Tasty.QuickCheck | ||||
| import Text.Megaparsec (runParser) | ||||
| import Text.Megaparsec        (runParser) | ||||
|  | ||||
| import qualified Data.Map as Map | ||||
| import qualified Data.Set as Set | ||||
| @ -31,6 +32,7 @@ tests = testGroup "Tricu Tests" | ||||
|   , lambdas | ||||
|   , baseLibrary | ||||
|   , fileEval | ||||
|   , modules | ||||
|   , demos | ||||
|   ] | ||||
|  | ||||
| @ -70,9 +72,9 @@ lexer = testGroup "Lexer Tests" | ||||
|         Right i -> i @?= expect | ||||
|  | ||||
|   , testCase "Error when using invalid characters in identifiers" $ do | ||||
|         case (runParser tricuLexer "" "__result = 5") of | ||||
|         case (runParser tricuLexer "" "!result = 5") of | ||||
|           Left _ -> return () | ||||
|           Right _ -> assertFailure "Expected failure when trying to assign the value of __result" | ||||
|           Right _ -> assertFailure "Expected failure when trying to assign the value of !result" | ||||
|   ] | ||||
|  | ||||
| parser :: TestTree | ||||
| @ -488,8 +490,9 @@ fileEval = testGroup "File evaluation tests" | ||||
|       res @?= Fork (Stem Leaf) Leaf | ||||
|  | ||||
|   , testCase "Mapping and Equality" $ do | ||||
|       res <- liftIO $ evaluateFileResult "./test/map.tri" | ||||
|       res @?= Stem Leaf | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       fEnv    <- liftIO $ evaluateFileWithContext library "./test/map.tri" | ||||
|       (mainResult fEnv) @?= Stem Leaf | ||||
|  | ||||
|   , testCase "Eval and decoding string" $ do | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
| @ -497,22 +500,54 @@ fileEval = testGroup "File evaluation tests" | ||||
|       decodeResult (result res) @?= "\"String test!\"" | ||||
|   ] | ||||
|  | ||||
| modules :: TestTree | ||||
| modules = testGroup "Test modules" | ||||
|   [ testCase "Detect cyclic dependencies" $ do | ||||
|       result <- try (liftIO $ evaluateFileResult "./test/cycle-1.tri") :: IO (Either SomeException T) | ||||
|       case result of | ||||
|         Left e -> do | ||||
|           let errorMsg = show e | ||||
|           if "Encountered cyclic import" `isInfixOf` errorMsg | ||||
|             then return () | ||||
|             else assertFailure $ "Unexpected error: " ++ errorMsg | ||||
|         Right _ -> assertFailure "Expected cyclic dependencies" | ||||
|   , testCase "Module imports and namespacing" $ do | ||||
|       res <- liftIO $ evaluateFileResult "./test/namespace-A.tri" | ||||
|       res @?= Leaf | ||||
|   , testCase "Multiple imports" $ do | ||||
|       res <- liftIO $ evaluateFileResult "./test/vars-A.tri" | ||||
|       res @?= Leaf | ||||
|   , testCase "Error on unresolved variable" $ do | ||||
|       result <- try (liftIO $ evaluateFileResult "./test/unresolved-A.tri") :: IO (Either SomeException T) | ||||
|       case result of | ||||
|         Left e -> do | ||||
|           let errorMsg = show e | ||||
|           if "undefinedVar" `isInfixOf` errorMsg | ||||
|             then return () | ||||
|             else assertFailure $ "Unexpected error: " ++ errorMsg | ||||
|         Right _ -> assertFailure "Expected unresolved variable error" | ||||
|   , testCase "Multi-level imports" $ do | ||||
|       res <- liftIO $ evaluateFileResult "./test/multi-level-A.tri" | ||||
|       res @?= Leaf | ||||
|   , testCase "Lambda expression namespaces" $ do | ||||
|       res <- liftIO $ evaluateFileResult "./test/lambda-A.tri" | ||||
|       res @?= Leaf | ||||
|   ] | ||||
|  | ||||
|  | ||||
| -- All of our demo tests are also module tests | ||||
| demos :: TestTree | ||||
| demos = testGroup "Test provided demo functionality" | ||||
|   [ testCase "Structural equality demo" $ do | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       res     <- liftIO $ evaluateFileWithContext library "./demos/equality.tri" | ||||
|       decodeResult (result res) @?= "t t" | ||||
|       res     <- liftIO $ evaluateFileResult "./demos/equality.tri" | ||||
|       decodeResult res @?= "t t" | ||||
|   , testCase "Convert values back to source code demo" $ do | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       res     <- liftIO $ evaluateFileWithContext library "./demos/toSource.tri" | ||||
|       decodeResult (result res) @?= "\"(t (t (t t) (t t t)) (t t (t t t)))\"" | ||||
|       res     <- liftIO $ evaluateFileResult "./demos/toSource.tri" | ||||
|       decodeResult res @?= "\"(t (t (t t) (t t t)) (t t (t t t)))\"" | ||||
|   , testCase "Determining the size of functions" $ do | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       res     <- liftIO $ evaluateFileWithContext library "./demos/size.tri" | ||||
|       decodeResult (result res) @?= "454" | ||||
|       res     <- liftIO $ evaluateFileResult "./demos/size.tri" | ||||
|       decodeResult res @?= "454" | ||||
|   , testCase "Level Order Traversal demo" $ do | ||||
|       library <- liftIO $ evaluateFile "./lib/base.tri" | ||||
|       res     <- liftIO $ evaluateFileWithContext library "./demos/levelOrderTraversal.tri" | ||||
|       decodeResult (result res) @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \"" | ||||
|       res     <- liftIO $ evaluateFileResult "./demos/levelOrderTraversal.tri" | ||||
|       decodeResult res @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \"" | ||||
|   ] | ||||
|  | ||||
| @ -2,7 +2,7 @@ | ||||
| -- t (t t) (t (t t t)) | ||||
| -- t (t t t) (t t) | ||||
| -- x = (\a : a) | ||||
| t (t t) t -- Fork (Stem Leaf) Leaf | ||||
| main = t (t t) t -- Fork (Stem Leaf) Leaf | ||||
| -- t t | ||||
| -- x | ||||
| -- x = (\a : a) | ||||
|  | ||||
							
								
								
									
										5
									
								
								test/cycle-1.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								test/cycle-1.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,5 @@ | ||||
| !module Cycle | ||||
|  | ||||
| !import "test/cycle-2.tri" Cycle2 | ||||
|  | ||||
| cycle1 = t Cycle2.cycle2 | ||||
							
								
								
									
										5
									
								
								test/cycle-2.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								test/cycle-2.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,5 @@ | ||||
| !module Cycle2 | ||||
|  | ||||
| !import "test/cycle-1.tri" Cycle1 | ||||
|  | ||||
| cycle2 = t Cycle1.cycle1 | ||||
| @ -1 +1 @@ | ||||
| t t t  | ||||
| main = t t t  | ||||
|  | ||||
							
								
								
									
										2
									
								
								test/lambda-A.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								test/lambda-A.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,2 @@ | ||||
| !module A | ||||
| main = (\x : x) t | ||||
							
								
								
									
										24
									
								
								test/map.tri
									
									
									
									
									
								
							
							
						
						
									
										24
									
								
								test/map.tri
									
									
									
									
									
								
							| @ -1,24 +1,2 @@ | ||||
| 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!")] | ||||
| main = equal? x [("Successfully concatenated two strings!")] | ||||
|  | ||||
							
								
								
									
										5
									
								
								test/modules-1.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								test/modules-1.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,5 @@ | ||||
| !module Test | ||||
|  | ||||
| !import "lib/base.tri" Lib | ||||
|  | ||||
| main = Lib.not? t | ||||
							
								
								
									
										1
									
								
								test/modules-2.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								test/modules-2.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1 @@ | ||||
| n = t t t | ||||
							
								
								
									
										3
									
								
								test/multi-level-A.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								test/multi-level-A.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,3 @@ | ||||
| !module A | ||||
| !import "./test/multi-level-B.tri" B | ||||
| main = B.main | ||||
							
								
								
									
										3
									
								
								test/multi-level-B.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								test/multi-level-B.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,3 @@ | ||||
| !module B | ||||
| !import "./test/multi-level-C.tri" C | ||||
| main = C.val | ||||
							
								
								
									
										2
									
								
								test/multi-level-C.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								test/multi-level-C.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,2 @@ | ||||
| !module C | ||||
| val = t | ||||
							
								
								
									
										3
									
								
								test/namespace-A.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								test/namespace-A.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,3 @@ | ||||
| !module A | ||||
| !import "./test/namespace-B.tri" B | ||||
| main = B.x | ||||
							
								
								
									
										2
									
								
								test/namespace-B.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								test/namespace-B.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,2 @@ | ||||
| !module B | ||||
| x = t | ||||
							
								
								
									
										2
									
								
								test/unresolved-A.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								test/unresolved-A.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,2 @@ | ||||
| !module A | ||||
| main = undefinedVar | ||||
							
								
								
									
										7
									
								
								test/vars-A.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								test/vars-A.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,7 @@ | ||||
| !module A | ||||
|  | ||||
| !import "./test/vars-B.tri" B | ||||
|  | ||||
| !import "./test/vars-C.tri" C | ||||
|  | ||||
| main = B.y (C.z) | ||||
							
								
								
									
										2
									
								
								test/vars-B.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								test/vars-B.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,2 @@ | ||||
| !module B | ||||
| y = \x : x | ||||
							
								
								
									
										2
									
								
								test/vars-C.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								test/vars-C.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,2 @@ | ||||
| !module C | ||||
| z = t | ||||
| @ -1,7 +1,7 @@ | ||||
| cabal-version: 1.12 | ||||
|  | ||||
| name:           tricu | ||||
| version:        0.10.0 | ||||
| version:        0.12.0 | ||||
| description:    A micro-language for exploring Tree Calculus | ||||
| author:         James Eversole | ||||
| maintainer:     james@eversole.co | ||||
|  | ||||
		Reference in New Issue
	
	Block a user
	