Initial take on easier imports

This commit is contained in:
James Eversole 2025-04-16 14:52:09 -05:00
parent b8e2743103
commit 87200e1db4
14 changed files with 92 additions and 43 deletions

View File

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

View File

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

View File

@ -1,4 +1,4 @@
!import "../lib/patterns.tri" !Local !import "../lib/Patterns.tri" !Local
-- We can do conditional pattern matching by providing a list of lists, where -- We can do conditional pattern matching by providing a list of lists, where
-- each sublist contains a boolean expression and a function to return if said -- each sublist contains a boolean expression and a function to return if said

View File

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

View File

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

6
install-lib.sh Executable file
View File

@ -0,0 +1,6 @@
#!/bin/bash
set -xe
mkdir -p $HOME/.local/share/tricu/lib
cp -r lib/* $HOME/.local/share/tricu/lib/

View File

@ -1,4 +1,4 @@
!import "base.tri" !Local !import "Base.tri" !Local
_ = t _ = t

View File

@ -1,5 +1,5 @@
!import "base.tri" !Local !import "Base.tri" !Local
!import "list.tri" List !import "List.tri" List
match_ = y (self value patterns : match_ = y (self value patterns :
triage triage

View File

@ -5,11 +5,12 @@ import Lexer
import Parser import Parser
import Research import Research
import Data.List (partition) import Data.List (partition, isSuffixOf)
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Control.Monad (foldM) import Control.Monad (foldM)
import System.IO import System.IO
import System.FilePath (takeDirectory, normalise, (</>)) import System.Directory (doesFileExist, getCurrentDirectory, getXdgDirectory, XdgDirectory(..))
import System.FilePath ((</>), takeDirectory, isAbsolute, normalise)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
@ -31,7 +32,7 @@ processImports seen base currentPath asts =
where where
isImp (SImport _ _) = True isImp (SImport _ _) = True
isImp _ = False isImp _ = False
getImportInfo (SImport p n) = Just (p, n, makeRelativeTo currentPath p) getImportInfo (SImport p n) = Just (p, n, p)
getImportInfo _ = Nothing getImportInfo _ = Nothing
evaluateFileResult :: FilePath -> IO T evaluateFileResult :: FilePath -> IO T
@ -81,11 +82,12 @@ preprocessFile' seen base currentPath = do
Left err -> errorWithoutStackTrace err Left err -> errorWithoutStackTrace err
Right (nonImports, importPaths) -> do Right (nonImports, importPaths) -> do
let seen' = Set.insert currentPath seen let seen' = Set.insert currentPath seen
imported <- concat <$> mapM (processImportPath seen' base) importPaths imported <- concat <$> mapM (processImportPath seen' base currentPath) importPaths
pure $ imported ++ nonImports pure $ imported ++ nonImports
where where
processImportPath seen base (path, name, importPath) = do processImportPath seen base currentFile (path, name, _) = do
ast <- preprocessFile' seen base importPath resolvedPath <- resolveImportPath currentFile path
ast <- preprocessFile' seen base resolvedPath
pure $ map (nsDefinition (if name == "!Local" then "" else name)) pure $ map (nsDefinition (if name == "!Local" then "" else name))
$ filter (not . isImp) ast $ filter (not . isImp) ast
isImp (SImport _ _) = True isImp (SImport _ _) = True
@ -96,6 +98,40 @@ makeRelativeTo f i =
let d = takeDirectory f let d = takeDirectory f
in normalise $ d </> i in normalise $ d </> i
resolveImportPath :: FilePath -> FilePath -> IO FilePath
resolveImportPath currentFile importPath = do
let pathWithExt = if ".tri" `isSuffixOf` importPath
then importPath
else importPath ++ ".tri"
let relativeToFile = makeRelativeTo currentFile pathWithExt
fileRelExists <- doesFileExist relativeToFile
if fileRelExists
then return relativeToFile
else if isAbsolute pathWithExt then do
exists <- doesFileExist pathWithExt
if exists
then return pathWithExt
else errorWithoutStackTrace $ "File not found: " ++ pathWithExt
else do
currentDir <- getCurrentDirectory
let currentPath = currentDir </> pathWithExt
currentExists <- doesFileExist currentPath
if currentExists
then return currentPath
else do
dataDir <- getXdgDirectory XdgData "tricu"
let libPath = dataDir </> "lib" </> pathWithExt
libExists <- doesFileExist libPath
if libExists
then return libPath
else errorWithoutStackTrace $ "File not found: " ++ pathWithExt ++
"\nSearched in:\n- " ++ relativeToFile ++
"\n- " ++ currentPath ++
"\n- " ++ libPath
nsDefinitions :: String -> [TricuAST] -> [TricuAST] nsDefinitions :: String -> [TricuAST] -> [TricuAST]
nsDefinitions moduleName = map (nsDefinition moduleName) nsDefinitions moduleName = map (nsDefinition moduleName)

View File

@ -18,6 +18,8 @@ import Data.List (dropWhile, dropWhileEnd, isPrefixOf)
import Data.Version (showVersion) import Data.Version (showVersion)
import Paths_tricu (version) import Paths_tricu (version)
import System.Console.Haskeline import System.Console.Haskeline
import System.Directory (doesFileExist, getCurrentDirectory, getXdgDirectory, XdgDirectory(..))
import System.FilePath ((</>), takeDirectory, isAbsolute)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as T import qualified Data.Text as T
@ -107,12 +109,16 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
res <- runMaybeT $ do res <- runMaybeT $ do
let fset = setComplete completeFilename defaultSettings let fset = setComplete completeFilename defaultSettings
path <- MaybeT $ runInputT fset $ path <- MaybeT $ runInputT fset $
getInputLineWithInitial "File path to load < " ("", "") getInputLineWithInitial "Module name or path to import < " ("", "")
currentDir <- liftIO getCurrentDirectory
let currentFile = currentDir </> "dummy.tri"
resolvedPath <- liftIO $ resolveImportPath currentFile (strip path)
text <- MaybeT $ liftIO $ handle (\e -> do text <- MaybeT $ liftIO $ handle (\e -> do
putStrLn $ "Error reading file: " ++ displayException (e :: IOException) putStrLn $ "Error reading file: " ++ displayException (e :: IOException)
return Nothing return Nothing
) $ Just <$> readFile (strip path) ) $ Just <$> readFile resolvedPath
case parseProgram (lexTricu text) of case parseProgram (lexTricu text) of
Left err -> do Left err -> do
@ -127,7 +133,7 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
lift $ outputStrLn "Namespace must start with an uppercase letter" lift $ outputStrLn "Namespace must start with an uppercase letter"
MaybeT $ return Nothing MaybeT $ return Nothing
else do else do
prog <- liftIO $ preprocessFile (strip path) prog <- liftIO $ preprocessFile resolvedPath
let code = case name of let code = case name of
"!Local" -> prog "!Local" -> prog
_ -> nsDefinitions name prog _ -> nsDefinitions name prog

View File

@ -366,98 +366,98 @@ lambdas = testGroup "Lambda Evaluation Tests"
providedLibraries :: TestTree providedLibraries :: TestTree
providedLibraries = testGroup "Library Tests" providedLibraries = testGroup "Library Tests"
[ testCase "Triage test Leaf" $ do [ testCase "Triage test Leaf" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "test t" let input = "test t"
env = decodeResult $ result $ evalTricu library (parseTricu input) env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Leaf\"" env @?= "\"Leaf\""
, testCase "Triage test (Stem Leaf)" $ do , testCase "Triage test (Stem Leaf)" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "test (t t)" let input = "test (t t)"
env = decodeResult $ result $ evalTricu library (parseTricu input) env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Stem\"" env @?= "\"Stem\""
, testCase "Triage test (Fork Leaf Leaf)" $ do , testCase "Triage test (Fork Leaf Leaf)" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "test (t t t)" let input = "test (t t t)"
env = decodeResult $ result $ evalTricu library (parseTricu input) env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Fork\"" env @?= "\"Fork\""
, testCase "Boolean NOT: true" $ do , testCase "Boolean NOT: true" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "not? true" let input = "not? true"
env = result $ evalTricu library (parseTricu input) env = result $ evalTricu library (parseTricu input)
env @?= Leaf env @?= Leaf
, testCase "Boolean NOT: false" $ do , testCase "Boolean NOT: false" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "not? false" let input = "not? false"
env = result $ evalTricu library (parseTricu input) env = result $ evalTricu library (parseTricu input)
env @?= Stem Leaf env @?= Stem Leaf
, testCase "Boolean AND TF" $ do , testCase "Boolean AND TF" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "and? (t t) (t)" let input = "and? (t t) (t)"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Leaf result env @?= Leaf
, testCase "Boolean AND FT" $ do , testCase "Boolean AND FT" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "and? (t) (t t)" let input = "and? (t) (t t)"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Leaf result env @?= Leaf
, testCase "Boolean AND FF" $ do , testCase "Boolean AND FF" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "and? (t) (t)" let input = "and? (t) (t)"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Leaf result env @?= Leaf
, testCase "Boolean AND TT" $ do , testCase "Boolean AND TT" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "and? (t t) (t t)" let input = "and? (t t) (t t)"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Stem Leaf result env @?= Stem Leaf
, testCase "List head" $ do , testCase "List head" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "head [(t) (t t) (t t t)]" let input = "head [(t) (t t) (t t t)]"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Leaf result env @?= Leaf
, testCase "List tail" $ do , testCase "List tail" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "head (tail (tail [(t) (t t) (t t t)]))" let input = "head (tail (tail [(t) (t t) (t t t)]))"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf result env @?= Fork Leaf Leaf
, testCase "List map" $ do , testCase "List map" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "head (tail (map (a : (t t t)) [(t) (t) (t)]))" let input = "head (tail (map (a : (t t t)) [(t) (t) (t)]))"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf result env @?= Fork Leaf Leaf
, testCase "Empty list check" $ do , testCase "Empty list check" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "emptyList? []" let input = "emptyList? []"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Stem Leaf result env @?= Stem Leaf
, testCase "Non-empty list check" $ do , testCase "Non-empty list check" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "not? (emptyList? [(1) (2) (3)])" let input = "not? (emptyList? [(1) (2) (3)])"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Stem Leaf result env @?= Stem Leaf
, testCase "Concatenate strings" $ do , testCase "Concatenate strings" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "append \"Hello, \" \"world!\"" let input = "append \"Hello, \" \"world!\""
env = decodeResult $ result $ evalTricu library (parseTricu input) env = decodeResult $ result $ evalTricu library (parseTricu input)
env @?= "\"Hello, world!\"" env @?= "\"Hello, world!\""
, testCase "Verifying Equality" $ do , testCase "Verifying Equality" $ do
library <- evaluateFile "./lib/list.tri" library <- evaluateFile "./lib/List.tri"
let input = "equal? (t t t) (t t t)" let input = "equal? (t t t) (t t t)"
env = evalTricu library (parseTricu input) env = evalTricu library (parseTricu input)
result env @?= Stem Leaf result env @?= Stem Leaf
@ -474,12 +474,12 @@ fileEval = testGroup "File evaluation tests"
res @?= Fork (Stem Leaf) Leaf res @?= Fork (Stem Leaf) Leaf
, testCase "Mapping and Equality" $ do , testCase "Mapping and Equality" $ do
library <- liftIO $ evaluateFile "./lib/list.tri" library <- liftIO $ evaluateFile "./lib/List.tri"
fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri" fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri"
(mainResult fEnv) @?= Stem Leaf (mainResult fEnv) @?= Stem Leaf
, testCase "Eval and decoding string" $ do , testCase "Eval and decoding string" $ do
library <- liftIO $ evaluateFile "./lib/list.tri" library <- liftIO $ evaluateFile "./lib/List.tri"
res <- liftIO $ evaluateFileWithContext library "./test/string.tri" res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
decodeResult (result res) @?= "\"String test!\"" decodeResult (result res) @?= "\"String test!\""
] ]

View File

@ -1,5 +1,4 @@
!import "lib/Base.tri"
!import "lib/base.tri"
!import "test/named-imports/2.tri" !import "test/named-imports/2.tri"
!import "test/named-imports/3.tri" ThreeRenamed !import "test/named-imports/3.tri" ThreeRenamed

View File

@ -26,6 +26,7 @@ executable tricu
base >=4.7 base >=4.7
, cmdargs , cmdargs
, containers , containers
, directory
, exceptions , exceptions
, filepath , filepath
, haskeline , haskeline
@ -55,6 +56,7 @@ test-suite tricu-tests
base base
, cmdargs , cmdargs
, containers , containers
, directory
, exceptions , exceptions
, filepath , filepath
, haskeline , haskeline