4 Commits

Author SHA1 Message Date
f4e50353ed Support for list literals in Lambdas
All checks were successful
Test, Build, and Release / test (push) Successful in 1m35s
Test, Build, and Release / build (push) Successful in 1m12s
2025-02-02 12:08:08 -06:00
f9864b8361 REPL namespaces; lib function for pattern matching
All checks were successful
Test, Build, and Release / test (push) Successful in 1m52s
Test, Build, and Release / build (push) Successful in 1m20s
Adds support for REPL namespacing, primarily to avoid `main` collisions.
Also adds a library function for an ergonomic pattern matching function
that I've been noodling on. I might explore ways to make list syntax
less annoying specifically for pattern matching like this.
2025-02-02 10:56:40 -06:00
1a9a4494e0 Caller-relative imports; smart deduping in imports
All checks were successful
Test, Build, and Release / test (push) Successful in 1m35s
Test, Build, and Release / build (push) Successful in 1m13s
2025-01-30 17:56:46 -06:00
a16a24a808 Replace placeholder xor? library function 2025-01-30 17:17:07 -06:00
26 changed files with 325 additions and 251 deletions

1
.gitignore vendored
View File

@ -9,3 +9,4 @@
WD
bin/
dist*
.tricu_history

View File

@ -1,4 +1,5 @@
!import "lib/base.tri" !Local
!import "../lib/base.tri" !Local
!import "../lib/list.tri" !Local
main = lambdaEqualsTC

View File

@ -1,4 +1,5 @@
!import "lib/base.tri" !Local
!import "../lib/base.tri" Lib
!import "../lib/list.tri" !Local
main = exampleTwo
-- Level Order Traversal of a labelled binary tree

View File

@ -1,4 +1,5 @@
!import "lib/base.tri" !Local
!import "../lib/base.tri" !Local
!import "../lib/list.tri" !Local
main = size size

View File

@ -1,4 +1,5 @@
!import "lib/base.tri" !Local
!import "../lib/base.tri" !Local
!import "../lib/list.tri" !Local
main = toSource not?
-- Thanks to intensionality, we can inspect the structure of a given value

View File

@ -34,6 +34,7 @@
devShells.default = pkgs.mkShell {
buildInputs = with pkgs; [
haskellPackages.cabal-install
haskellPackages.ghc-events
haskellPackages.ghcid
customGHC
upx

View File

@ -1,13 +1,8 @@
false = t
_ = t
true = 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)
id = \a : a
const = \a b : a
pair = t
if = \cond then else : t (t else (t t then)) t cond
@ -26,28 +21,6 @@ matchBool = (\ot of : triage
(\_ _ : ot)
)
matchList = \a b : triage a _ b
matchPair = \a : triage _ _ a
not? = matchBool false true
and? = matchBool id (\_ : false)
emptyList? = matchList true (\_ _ : false)
head = matchList t (\head _ : head)
tail = matchList t (\_ tail : tail)
or? = (\x y :
matchBool
(matchBool (t t) (t t) y)
(matchBool (t t) 0 y)
x)
xor? = matchBool id not?
append = y (\self : matchList
(\k : k)
(\h r k : pair h (self r k)))
lAnd = (triage
(\_ : false)
(\_ x : x)
@ -58,11 +31,22 @@ lOr = (triage
(\_ _ : true)
(\_ _ _ : true))
map_ = y (\self :
matchList
(\_ : t)
(\head tail f : pair (f head) (self tail f)))
map = \f l : map_ l f
matchPair = \a : triage _ _ a
not? = matchBool false true
and? = matchBool id (\_ : false)
or? = (\x z :
matchBool
(matchBool true true z)
(matchBool true false z)
x)
xor? = (\x z :
matchBool
(matchBool false true z)
(matchBool true false z)
x)
equal? = y (\self : triage
(triage
@ -80,21 +64,6 @@ equal? = y (\self : triage
(\_ : false)
(\bx by : lAnd (self ax bx) (self ay by))))
lExist? = y (\self x : matchList
false
(\h z : or? (equal? x h) (self x z)))
filter_ = y (\self : matchList
(\_ : t)
(\head tail f : matchBool (t head) i (f head) (self tail f)))
filter = \f l : filter_ l f
foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
foldl = \f x l : foldl_ f l x
foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
foldr = \f x l : foldr_ x f l
succ = y (\self :
triage
1
@ -103,48 +72,3 @@ succ = y (\self :
(t (t t))
(\_ tail : t t (self tail))
t))
length = y (\self : matchList
0
(\_ tail : succ (self tail)))
reverse = y (\self : matchList
t
(\head tail : append (self tail) (pair head t)))
snoc = y (\self x : matchList
(pair x t)
(\h z : pair h (self x z)))
count = y (\self x : matchList
0
(\h z : matchBool
(succ (self x z))
(self x z)
(equal? x h)))
last = y (\self : matchList
t
(\hd tl : matchBool
hd
(self tl)
(emptyList? tl)))
all? = y (\self pred : matchList
true
(\h z : and? (pred h) (self pred z)))
any? = y (\self pred : matchList
false
(\h z : or? (pred h) (self pred z)))
unique_ = y (\self seen : matchList
t
(\head rest : matchBool
(self seen rest)
(pair head (self (pair head seen) rest))
(lExist? head seen)))
unique = \xs : unique_ t xs
intersect = \xs ys : filter (\x : lExist? x ys) xs
union = \xs ys : unique (append xs ys)

77
lib/list.tri Normal file
View File

@ -0,0 +1,77 @@
!import "base.tri" !Local
matchList = \a b : triage a _ b
emptyList? = matchList true (\_ _ : false)
head = matchList t (\head _ : head)
tail = matchList t (\_ tail : tail)
append = y (\self : matchList
(\k : k)
(\h r k : pair h (self r k)))
lExist? = y (\self x : matchList
false
(\h z : or? (equal? x h) (self x z)))
map_ = y (\self :
matchList
(\_ : t)
(\head tail f : pair (f head) (self tail f)))
map = \f l : map_ l f
filter_ = y (\self : matchList
(\_ : t)
(\head tail f : matchBool (t head) id (f head) (self tail f)))
filter = \f l : filter_ l f
foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
foldl = \f x l : foldl_ f l x
foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
foldr = \f x l : foldr_ x f l
length = y (\self : matchList
0
(\_ tail : succ (self tail)))
reverse = y (\self : matchList
t
(\head tail : append (self tail) (pair head t)))
snoc = y (\self x : matchList
(pair x t)
(\h z : pair h (self x z)))
count = y (\self x : matchList
0
(\h z : matchBool
(succ (self x z))
(self x z)
(equal? x h)))
last = y (\self : matchList
t
(\hd tl : matchBool
hd
(self tl)
(emptyList? tl)))
all? = y (\self pred : matchList
true
(\h z : and? (pred h) (self pred z)))
any? = y (\self pred : matchList
false
(\h z : or? (pred h) (self pred z)))
unique_ = y (\self seen : matchList
t
(\head rest : matchBool
(self seen rest)
(pair head (self (pair head seen) rest))
(lExist? head seen)))
unique = \xs : unique_ t xs
intersect = \xs ys : filter (\x : lExist? x ys) xs
union = \xs ys : unique (append xs ys)

35
lib/patterns.tri Normal file
View File

@ -0,0 +1,35 @@
!import "list.tri" !Local
match_ = y (\self value patterns :
triage
t
(\_ : t)
(\pattern rest :
triage
t
(\_ : t)
(\test result :
if (test value)
(result value)
(self value rest))
pattern)
patterns)
match = (\value patterns :
match_ value (map (\sublist :
pair (head sublist) (head (tail sublist)))
patterns))
otherwise = const (t t)
-- matchExample = (\x : match x [[(equal? 1) (\_ : "one")]
-- [(equal? 2) (\_ : "two")]
-- [(equal? 3) (\_ : "three")]
-- [(equal? 4) (\_ : "four")]
-- [(equal? 5) (\_ : "five")]
-- [(equal? 6) (\_ : "six")]
-- [(equal? 7) (\_ : "seven")]
-- [(equal? 8) (\_ : "eight")]
-- [(equal? 9) (\_ : "nine")]
-- [(equal? 10) (\_ : "ten")]
-- [ otherwise (\_ : "I ran out of fingers!")]])

View File

@ -19,16 +19,16 @@ evalSingle env term
Nothing ->
let res = evalAST env body
in Map.insert "!result" res (Map.insert name res env)
| SApp func arg <- term
| SApp func arg <- term
= let res = apply (evalAST env func) (evalAST env arg)
in Map.insert "!result" res env
| SVar name <- term
| 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
| otherwise
= Map.insert "!result" (evalAST env term) env
evalTricu :: Env -> [TricuAST] -> Env
@ -75,6 +75,9 @@ elimLambda = go
go (SLambda [f] (SLambda [g] (SLambda [x] body)))
| body == SApp (SVar f) (SApp (SVar g) (SVar x)) = _B
-- General elimination
go (SLambda [v] (SList xs))
= elimLambda (SLambda [v] (foldr wrapTLeaf TLeaf xs))
where wrapTLeaf m r = SApp (SApp TLeaf m) r
go (SLambda (v:vs) body)
| null vs = toSKI v (elimLambda body)
| otherwise = elimLambda (SLambda [v] (SLambda vs body))
@ -141,18 +144,23 @@ reorderDefs env defs
buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
buildDepGraph topDefs
| not (null duplicateNames) =
| not (null conflictingDefs) =
errorWithoutStackTrace $
"Duplicate definitions detected: " ++ show duplicateNames
"Conflicting definitions detected: " ++ show conflictingDefs
| otherwise =
Map.fromList
[ (name, depends topDefs (SDef name [] body))
| SDef name _ body <- topDefs]
where
names = [name | SDef name _ _ <- topDefs]
duplicateNames =
[ name | (name, count) <- Map.toList (countOccurrences names) , count > 1]
countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty
defsMap = Map.fromListWith (++)
[(name, [(name, body)]) | SDef name _ body <- topDefs]
conflictingDefs =
[ name
| (name, defs) <- Map.toList defsMap
, let bodies = map snd defs
, not $ all (== head bodies) (tail bodies)
]
sortDeps :: Map.Map String (Set.Set String) -> [String]
sortDeps graph = go [] Set.empty (Map.keys graph)

View File

@ -6,12 +6,34 @@ import Parser
import Research
import Data.List (partition)
import Data.Maybe (mapMaybe)
import Control.Monad (foldM)
import System.IO
import System.FilePath (takeDirectory, normalise, (</>))
import qualified Data.Map as Map
import qualified Data.Set as Set
extractMain :: Env -> Either String T
extractMain env =
case Map.lookup "main" env of
Just result -> Right result
Nothing -> Left "No `main` function detected"
processImports :: Set.Set FilePath -> FilePath -> FilePath -> [TricuAST]
-> Either String ([TricuAST], [(FilePath, String, FilePath)])
processImports seen base currentPath asts =
let (imports, nonImports) = partition isImp asts
importPaths = mapMaybe getImportInfo imports
in if currentPath `Set.member` seen
then Left $ "Encountered cyclic import: " ++ currentPath
else Right (nonImports, importPaths)
where
isImp (SImport _ _) = True
isImp _ = False
getImportInfo (SImport p n) = Just (p, n, makeRelativeTo currentPath p)
getImportInfo _ = Nothing
evaluateFileResult :: FilePath -> IO T
evaluateFileResult filePath = do
contents <- readFile filePath
@ -19,11 +41,11 @@ evaluateFileResult filePath = do
case parseProgram tokens of
Left err -> errorWithoutStackTrace (handleParseError err)
Right ast -> do
ast <- preprocessFile filePath
let finalEnv = evalTricu Map.empty ast
case Map.lookup "main" finalEnv of
Just finalResult -> return finalResult
Nothing -> errorWithoutStackTrace "No `main` function detected"
processedAst <- preprocessFile filePath
let finalEnv = evalTricu Map.empty processedAst
case extractMain finalEnv of
Right result -> return result
Left err -> errorWithoutStackTrace err
evaluateFile :: FilePath -> IO Env
evaluateFile filePath = do
@ -46,38 +68,33 @@ evaluateFileWithContext env filePath = do
pure $ evalTricu env ast
preprocessFile :: FilePath -> IO [TricuAST]
preprocessFile = preprocessFile' Set.empty
preprocessFile p = preprocessFile' Set.empty p p
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 (imports, nonImports) = partition isImport asts
let newInProgress = Set.insert filePath inProgress
importedASTs <- concat <$>
mapM (processImport newInProgress "") imports
pure $ importedASTs ++ nonImports
preprocessFile' :: Set.Set FilePath -> FilePath -> FilePath -> IO [TricuAST]
preprocessFile' seen base currentPath = do
contents <- readFile currentPath
let tokens = lexTricu contents
case parseProgram tokens of
Left err -> errorWithoutStackTrace (handleParseError err)
Right ast ->
case processImports seen base currentPath ast of
Left err -> errorWithoutStackTrace err
Right (nonImports, importPaths) -> do
let seen' = Set.insert currentPath seen
imported <- concat <$> mapM (processImportPath seen' base) importPaths
pure $ imported ++ nonImports
where
isImport :: TricuAST -> Bool
isImport (SImport _ _) = True
isImport _ = False
processImportPath seen base (path, name, importPath) = do
ast <- preprocessFile' seen base importPath
pure $ map (nsDefinition (if name == "!Local" then "" else name))
$ filter (not . isImp) ast
isImp (SImport _ _) = True
isImp _ = False
processImport :: Set.Set FilePath -> String -> TricuAST -> IO [TricuAST]
processImport prog currentModule (SImport path "!Local") = do
ast <- preprocessFile' prog path
let defs = filter (not . isImport) ast
pure $ map (nsDefinition currentModule) defs
processImport prog _ (SImport path name) = do
ast <- preprocessFile' prog path
let defs = filter (not . isImport) ast
pure $ map (nsDefinition name) defs
processImport _ _ _ = error "Unexpected non-import in processImport"
makeRelativeTo :: FilePath -> FilePath -> FilePath
makeRelativeTo f i =
let d = takeDirectory f
in normalise $ d </> i
nsDefinitions :: String -> [TricuAST] -> [TricuAST]
nsDefinitions moduleName = map (nsDefinition moduleName)
@ -86,7 +103,7 @@ nsDefinition :: String -> TricuAST -> TricuAST
nsDefinition "" def = def
nsDefinition moduleName (SDef name args body)
| isPrefixed name = SDef name args (nsBody moduleName body)
| otherwise = SDef (nsVariable moduleName name)
| otherwise = SDef (nsVariable moduleName name)
args (nsBody moduleName body)
nsDefinition moduleName other =
nsBody moduleName other
@ -107,7 +124,7 @@ nsBody moduleName (TStem subtree) =
TStem (nsBody moduleName subtree)
nsBody moduleName (SDef name args body)
| isPrefixed name = SDef name args (nsBody moduleName body)
| otherwise = SDef (nsVariable moduleName name)
| otherwise = SDef (nsVariable moduleName name)
args (nsBody moduleName body)
nsBody _ other = other
@ -117,19 +134,19 @@ nsBodyScoped moduleName args body = case body of
if name `elem` args
then SVar name
else nsBody moduleName (SVar name)
SApp func arg ->
SApp func arg ->
SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
SLambda innerArgs innerBody ->
SLambda innerArgs innerBody ->
SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
SList items ->
SList items ->
SList (map (nsBodyScoped moduleName args) items)
TFork left right ->
TFork (nsBodyScoped moduleName args left)
TFork left right ->
TFork (nsBodyScoped moduleName args left)
(nsBodyScoped moduleName args right)
TStem subtree ->
TStem subtree ->
TStem (nsBodyScoped moduleName args subtree)
SDef name innerArgs innerBody ->
SDef (nsVariable moduleName name) innerArgs
SDef (nsVariable moduleName name) innerArgs
(nsBodyScoped moduleName (args ++ innerArgs) innerBody)
other -> other

View File

@ -59,7 +59,7 @@ keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
identifier :: Lexer LToken
identifier = do
first <- lowerChar <|> char '_'
rest <- many $ letterChar
rest <- many $ letterChar
<|> digitChar <|> char '_' <|> char '-' <|> char '?'
<|> char '$' <|> char '#' <|> char '@' <|> char '%'
let name = first : rest

View File

@ -255,9 +255,9 @@ parseSingleItemM = do
parseVarM :: ParserM TricuAST
parseVarM = do
token <- satisfyM (\case
token <- satisfyM (\case
LNamespace _ -> True
LIdentifier _ -> True
LIdentifier _ -> True
_ -> False)
case token of
LNamespace ns -> do

View File

@ -6,21 +6,35 @@ import Lexer
import Parser
import Research
import Control.Exception (SomeException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Catch (handle, MonadCatch)
import Data.Char (isSpace)
import Data.List ( dropWhile
, dropWhileEnd
, intercalate
, isPrefixOf)
import Control.Exception (SomeException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Catch (handle, MonadCatch)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Data.Char (isSpace)
import Data.List ( dropWhile
, dropWhileEnd
, isPrefixOf)
import System.Console.Haskeline
import qualified Data.Map as Map
repl :: Env -> IO ()
repl env = runInputT defaultSettings (withInterrupt (loop env True))
repl env = runInputT settings (withInterrupt (loop env True))
where
settings :: Settings IO
settings = Settings
{ complete = completeWord Nothing " \t" completeCommands
, historyFile = Just ".tricu_history"
, autoAddHistory = True
}
completeCommands :: String -> IO [Completion]
completeCommands str = return $ map simpleCompletion $
filter (str `isPrefixOf`) commands
where
commands = ["!exit", "!decode", "!definitions", "!import"]
loop :: Env -> Bool -> InputT IO ()
loop env decode = handle (interruptHandler env decode) $ do
minput <- getInputLine "tricu < "
@ -32,26 +46,48 @@ repl env = runInputT defaultSettings (withInterrupt (loop env True))
| strip s == "!decode" -> do
outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
loop env (not decode)
| "!import" `isPrefixOf` strip s -> do
let afterImport = dropWhile (== ' ') $ drop (length ("!import" :: String)) (strip s)
if not (null afterImport)
then outputStrLn "Warning: REPL imports are interactive; \
\additional arguments are ignored."
else pure ()
path <- getInputLine "File path to load < "
case path of
Nothing -> do
outputStrLn "No input received; stopping import."
loop env decode
Just p -> do
loadedEnv <- liftIO $ evaluateFileWithContext env
(strip p) `catch` \e -> errorHandler env e
loop (Map.delete "!result" (Map.union loadedEnv env)) decode
| strip s == "!definitions" -> do
let defs = Map.keys $ Map.delete "!result" env
if null defs
then outputStrLn "No definitions discovered."
else do
outputStrLn "Available definitions:"
mapM_ outputStrLn defs
loop env decode
| "!import" `isPrefixOf` strip s -> handleImport env decode
| take 2 s == "--" -> loop env decode
| otherwise -> do
newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
loop newEnv decode
handleImport :: Env -> Bool -> InputT IO ()
handleImport env decode = do
result <- runMaybeT $ do
let fileSettings = setComplete completeFilename defaultSettings
path <- MaybeT $ runInputT fileSettings $
getInputLineWithInitial "File path to load < " ("", "")
contents <- liftIO $ readFile (strip path)
if | Left err <- parseProgram (lexTricu contents) -> do
lift $ outputStrLn $ "Parse error: " ++ handleParseError err
MaybeT $ return Nothing
| Right ast <- parseProgram (lexTricu contents) -> do
ns <- MaybeT $ runInputT defaultSettings $
getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
processedAst <- liftIO $ preprocessFile (strip path)
let namespacedAst | strip ns == "!Local" = processedAst
| otherwise = nsDefinitions (strip ns) processedAst
loadedEnv = evalTricu env namespacedAst
return loadedEnv
if | Nothing <- result -> do
outputStrLn "Import cancelled."
loop env decode
| Just loadedEnv <- result ->
loop (Map.delete "!result" loadedEnv) decode
interruptHandler :: Env -> Bool -> Interrupt -> InputT IO ()
interruptHandler env decode _ = do
outputStrLn "Interrupted with CTRL+C\n\
@ -64,17 +100,17 @@ repl env = runInputT defaultSettings (withInterrupt (loop env True))
newEnv = evalTricu env asts
case Map.lookup "!result" newEnv of
Just r -> do
putStrLn $ "tricu > " ++
if decode
putStrLn $ "tricu > " ++
if decode
then decodeResult r
else show r
Nothing -> pure ()
return newEnv
errorHandler :: Env -> SomeException -> IO (Env)
errorHandler env e = do
putStrLn $ "Error: " ++ show e
return env
strip :: String -> String
strip = dropWhileEnd isSpace . dropWhile isSpace

View File

@ -53,7 +53,7 @@ data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
deriving (Show, Data, Typeable)
-- Environment containing previously evaluated TC terms
type Env = Map.Map String T
type Env = Map.Map String T
-- Tree Calculus Reduction
apply :: T -> T -> T
@ -122,7 +122,7 @@ formatResult Ascii = toAscii
formatResult Decode = decodeResult
toSimpleT :: String -> String
toSimpleT s = T.unpack
toSimpleT s = T.unpack
$ replace "Fork" "t"
$ replace "Stem" "t"
$ replace "Leaf" "t"

View File

@ -30,7 +30,7 @@ tests = testGroup "Tricu Tests"
, parser
, simpleEvaluation
, lambdas
, baseLibrary
, providedLibraries
, fileEval
, modules
, demos
@ -341,139 +341,107 @@ lambdas = testGroup "Lambda Evaluation Tests"
, testCase "Lambda with a list literal" $ do
let input = "f = (\\x : x)\nf [t (t t)]"
runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
, testCase "Lambda with list literal" $ do
let input = "(\\a : [(a)]) 1"
runTricu input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
]
baseLibrary :: TestTree
baseLibrary = testGroup "Library Tests"
[ testCase "K combinator 1" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "K combinator 2" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "K combinator 3" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t t t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
, testCase "S combinator" $ do
library <- evaluateFile "./lib/base.tri"
let input = "s (t) (t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf (Stem Leaf)
, testCase "SKK == I (fully expanded)" $ do
library <- evaluateFile "./lib/base.tri"
let input = "s k k"
env = evalTricu library (parseTricu input)
result env @?= Fork (Stem (Stem Leaf)) (Stem Leaf)
, testCase "I combinator" $ do
library <- evaluateFile "./lib/base.tri"
let input = "i not?"
env = evalTricu library (parseTricu input)
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) (Fork Leaf (Fork Leaf Leaf))
, testCase "Triage test Leaf" $ do
library <- evaluateFile "./lib/base.tri"
providedLibraries :: TestTree
providedLibraries = testGroup "Library Tests"
[ testCase "Triage test Leaf" $ do
library <- evaluateFile "./lib/list.tri"
let input = "test t"
env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Leaf\""
, testCase "Triage test (Stem Leaf)" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "test (t t)"
env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Stem\""
, testCase "Triage test (Fork Leaf Leaf)" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "test (t t t)"
env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Fork\""
, testCase "Boolean NOT: true" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "not? true"
env = result $ evalTricu library (parseTricu input)
env @?= Leaf
, testCase "Boolean NOT: false" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "not? false"
env = result $ evalTricu library (parseTricu input)
env @?= Stem Leaf
, testCase "Boolean AND TF" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "and? (t t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND FT" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "and? (t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND FF" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "and? (t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND TT" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "and? (t t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "List head" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "head [(t) (t t) (t t t)]"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "List tail" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "head (tail (tail [(t) (t t) (t t t)]))"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
, testCase "List map" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "head (tail (map (\\a : (t t t)) [(t) (t) (t)]))"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
, testCase "Empty list check" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "emptyList? []"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Non-empty list check" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "not? (emptyList? [(1) (2) (3)])"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Concatenate strings" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "append \"Hello, \" \"world!\""
env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Hello, world!\""
, testCase "Verifying Equality" $ do
library <- evaluateFile "./lib/base.tri"
library <- evaluateFile "./lib/list.tri"
let input = "equal? (t t t) (t t t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
@ -490,12 +458,12 @@ fileEval = testGroup "File evaluation tests"
res @?= Fork (Stem Leaf) Leaf
, testCase "Mapping and Equality" $ do
library <- liftIO $ evaluateFile "./lib/base.tri"
library <- liftIO $ evaluateFile "./lib/list.tri"
fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri"
(mainResult fEnv) @?= Stem Leaf
, testCase "Eval and decoding string" $ do
library <- liftIO $ evaluateFile "./lib/base.tri"
library <- liftIO $ evaluateFile "./lib/list.tri"
res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
decodeResult (result res) @?= "\"String test!\""
]

View File

@ -1,4 +1,4 @@
!import "test/cycle-2.tri" Cycle2
!import "cycle-2.tri" Cycle2
cycle1 = t Cycle2.cycle2

View File

@ -1,4 +1,4 @@
!import "test/cycle-1.tri" Cycle1
!import "cycle-1.tri" Cycle1
cycle2 = t Cycle1.cycle1

View File

@ -1,4 +1,4 @@
!import "test/local-ns/2.tri" Two
!import "2.tri" Two
main = Two.x

View File

@ -1,2 +1,2 @@
!import "test/local-ns/3.tri" !Local
!import "3.tri" !Local

View File

@ -1,2 +1 @@
x = 3

View File

@ -1,2 +1,2 @@
!import "./test/multi-level-B.tri" B
!import "multi-level-B.tri" B
main = B.main

View File

@ -1,2 +1,2 @@
!import "./test/multi-level-C.tri" C
!import "multi-level-C.tri" C
main = C.val

View File

@ -1,2 +1,2 @@
!import "./test/namespace-B.tri" B
!import "namespace-B.tri" B
main = B.x

View File

@ -1,6 +1,6 @@
!import "./test/vars-B.tri" B
!import "vars-B.tri" B
!import "./test/vars-C.tri" C
!import "vars-C.tri" C
main = B.y (C.z)

View File

@ -1,7 +1,7 @@
cabal-version: 1.12
name: tricu
version: 0.13.0
version: 0.16.0
description: A micro-language for exploring Tree Calculus
author: James Eversole
maintainer: james@eversole.co
@ -27,10 +27,12 @@ executable tricu
, cmdargs
, containers
, exceptions
, filepath
, haskeline
, megaparsec
, mtl
, text
, transformers
other-modules:
Eval
FileEval
@ -54,6 +56,7 @@ test-suite tricu-tests
, cmdargs
, containers
, exceptions
, filepath
, haskeline
, megaparsec
, mtl
@ -61,6 +64,7 @@ test-suite tricu-tests
, tasty-hunit
, tasty-quickcheck
, text
, transformers
default-language: Haskell2010
other-modules:
Eval