diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Eval.hs | 21 | ||||
-rw-r--r-- | src/Helper.hs | 2 | ||||
-rw-r--r-- | src/Parser.hs | 22 |
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 |