aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Eval.hs21
-rw-r--r--src/Helper.hs2
-rw-r--r--src/Parser.hs22
3 files changed, 34 insertions, 11 deletions
diff --git a/src/Eval.hs b/src/Eval.hs
index 77e5990..5494ee7 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -19,6 +19,7 @@ import System.Console.Haskeline.Completion
import System.Directory
import System.Environment
import System.Exit
+import System.FilePath.Posix ( takeBaseName )
import System.IO
import Text.Megaparsec hiding ( State
, try
@@ -29,6 +30,7 @@ data EnvState = EnvState
}
type M = StrictState.StateT EnvState IO
+-- TODO: Force naming convention for namespaces/files
loadFile :: String -> IO EnvState
loadFile path = do
file <- try $ readFile path :: IO (Either IOError String)
@@ -75,8 +77,8 @@ evalTest exp1 exp2 =
)
eval :: [String] -> EnvState -> Bool -> IO EnvState
-eval [] state@(EnvState env) _ = return state
-eval [""] state@(EnvState env) _ = return state
+eval [] state _ = return state
+eval [""] state _ = return state
eval (line : ls) state@(EnvState env) isRepl =
handleInterrupt (putStrLn "<aborted>" >> return state)
$ case parse lineParser "" line of
@@ -91,10 +93,17 @@ eval (line : ls) state@(EnvState env) isRepl =
then (putStrLn $ name <> " = " <> show exp)
>> return (EnvState env')
else eval ls (EnvState env') isRepl
- Import path -> do
- lib <- getDataFileName path -- TODO: Use actual lib directory
- exists <- doesFileExist lib
- loadFile $ if exists then lib else path
+ -- TODO: Import loop detection
+ -- TODO: Don't import subimports into main env
+ Import path namespace -> do
+ lib <- getDataFileName path -- TODO: Use actual lib directory
+ exists <- doesFileExist lib
+ EnvState env' <- loadFile $ if exists then lib else path
+ let prefix | null namespace = takeBaseName path ++ "."
+ | namespace == "." = ""
+ | otherwise = namespace ++ "."
+ env' <- pure $ map (\(n, e) -> (prefix ++ n, e)) env'
+ eval ls (EnvState $ env <> env') isRepl
Evaluate exp ->
let (res, env') = evalExp exp `runState` env
in
diff --git a/src/Helper.hs b/src/Helper.hs
index 76a1f83..5c31aba 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -12,7 +12,7 @@ type Failable = Either Error
data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression
deriving (Ord, Eq)
-data Instruction = Define String Expression | Evaluate Expression | Comment String | Import String | Test Expression Expression
+data Instruction = Define String Expression | Evaluate Expression | Comment String | Import String String | Test Expression Expression
deriving (Show)
instance Show Expression where
show (Bruijn x ) = "\ESC[31m" <> show x <> "\ESC[0m"
diff --git a/src/Parser.hs b/src/Parser.hs
index dc6951a..f4afb69 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -22,9 +22,21 @@ lexeme = L.lexeme sc
symbol :: String -> Parser String
symbol = L.symbol sc
+-- def identifier disallows the import prefix dots
+defIdentifier :: Parser String
+defIdentifier = lexeme
+ ((:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> oneOf "?!'_-"))
+
+-- TODO: write as extension to defIdentifier
identifier :: Parser String
identifier = lexeme
- ((:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> oneOf "?!'_-"))
+ ((:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> oneOf "?!'_-."))
+
+namespace :: Parser String
+namespace =
+ lexeme ((:) <$> upperChar <*> many letterChar)
+ <|> string "."
+ <|> (space >> return "")
parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")
@@ -93,13 +105,13 @@ parseEvaluate = Evaluate <$> parseExpression
parseDefine :: Parser Instruction
parseDefine = do
- var <- identifier
+ var <- defIdentifier
space
Define var <$> parseExpression
parseReplDefine :: Parser Instruction
parseReplDefine = do
- var <- identifier
+ var <- defIdentifier
space
symbol "="
space
@@ -114,7 +126,9 @@ parseImport = do
space
path <- importPath
space
- pure $ Import $ path ++ ".bruijn"
+ ns <- namespace
+ space
+ pure $ Import (path ++ ".bruijn") ns
parsePrint :: Parser Instruction
parsePrint = do