# Modules

Basic implementation of a module system including tests.

src/Eval.hs

@@ -17,19 +17,19 @@ evalSingle env term
               "Error: Identifier '" ++ name ++ "' is already defined."
         | otherwise ->
             let res = evalAST env body
-            in Map.insert "__result" res (Map.insert name res env)
+            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
+      in Map.insert "!result" res env
   | SVar name <- term =
       case Map.lookup name env of
         Just v  ->
-          Map.insert "__result" v env
+          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
+      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
@@ -180,9 +181,9 @@ 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

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 "main" finalEnv of
-    Just finalResult -> return finalResult
-    Nothing -> errorWithoutStackTrace "No `main` function detected"
+  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

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

src/Main.hs

@@ -61,7 +61,7 @@ main = 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.delete "!result" library
     Evaluate { file = filePaths, form = form } -> do
       result <- case filePaths of
         [] -> do

src/Parser.hs

@@ -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)

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

src/Research.hs

@@ -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,6 +44,8 @@ data LToken
   | LOpenBracket
   | LCloseBracket
   | LNewline
+  | LModule String
+  | LImport String String
   deriving (Show, Eq, Ord)
 
 -- Output formats