Implement naive export system

6 files changed, 130 insertions, 14 deletions

diff --git a/app/Main.hs b/app/Main.hs
index c71fd2f..45540aa 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -19,6 +19,8 @@ parseArgs config args =
             config { configPrintEvaled = True } rest
         ("-s":rest) -> parseArgs
             config { configPrintCallStack = True } rest
+        ("-r":rest) -> parseArgs
+            config { configUseREPL = True } rest
         _ -> config
 
 repl :: Config -> Env -> InputT IO ()
@@ -47,7 +49,8 @@ main = do
         configVerboseMode = False,
         configShowHelp = False,
         configPrintEvaled = False,
-        configPrintCallStack = False
+        configPrintCallStack = False,
+        configUseREPL = False
     }
 
     let config = parseArgs initialConfig args
@@ -58,10 +61,15 @@ main = do
         putStrLn $ "       " ++ progName ++ " -h              # to show this help"
         putStrLn $ "       " ++ progName ++ " -e              # to automatically print results of evaluated expressions to stdout"
         putStrLn $ "       " ++ progName ++ " -s              # to automatically print call stack of evaluated expressions to stdout"
+        putStrLn $ "       " ++ progName ++ " -r              # to open REPL, even after script file execution"
     else do
         when (configVerboseMode config) $ do
             putStrLn $ "configScriptFileName:\t" ++ (show $ configScriptFileName config)
             putStrLn $ "configVerboseMode:\t" ++ (show $ configVerboseMode config)
+            putStrLn $ "configShowHelp:\t" ++ (show $ configShowHelp config)
+            putStrLn $ "configPrintEvaled:\t" ++ (show $ configPrintEvaled config)
+            putStrLn $ "configPrintCallStack:\t" ++ (show $ configPrintCallStack config)
+            putStrLn $ "configUseREPL:\t" ++ (show $ configUseREPL config)
 
         case (configScriptFileName config) of
             Just scriptFileName -> do
@@ -70,10 +78,10 @@ main = do
                     Left (LException mp ex) -> case mp of
                         Just p -> putStrLn $ p ++ " error: " ++ ex
                         Nothing -> putStrLn $ "error: " ++ ex
-                    Right _ -> return ()
+                    Right (evaledEnv, _) -> do
+                        when (configUseREPL config) $
+                            runInputT defaultSettings (repl config evaledEnv)
             Nothing -> do
                 putStrLn $ "Lang REPL"
                 putStrLn $ "Use CTRL+D to exit"
                 runInputT defaultSettings (repl config builtinEnv)
-
-    return ()
diff --git a/examples/import.lisp b/examples/import.lisp
index d302562..1a2f6f1 100644
--- a/examples/import.lisp
+++ b/examples/import.lisp
@@ -1,3 +1,2 @@
-(import! M "examples/maybe.lisp")
-
-(print! (fmt "{0}\n" [(M:just 666)]))
+(import! "stdlib/common.lisp")
+(import! M "stdlib/maybe.lisp")
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 33e36ea..37996f4 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -191,12 +191,34 @@ evaluateImport d env asts = do
 
     case args of
         [AST { astNode = ASTSymbol qualifier }, AST { astNode = ASTString path }] -> do
-            (importedEnv, _) <- runScriptFile builtinEnv path
-            let nameMangled = M.mapKeys (\k -> qualifier ++ ":" ++ k) importedEnv
-            return (M.union env nameMangled, importAst { astNode = ASTUnit })
+            (evaledRawEnv, _) <- runScriptFile builtinEnv path
+            let exportsVecASTM = M.lookup "exports" evaledRawEnv
+            exportedEnv <- case exportsVecASTM of
+                Just (AST { astNode = ASTVector exportsVec }) -> do
+                    exportSyms <- exportsVec $>
+                        mapM (\case AST { astNode = ASTSymbol sym } -> return sym
+                                    ast -> throwL (astPos ast) $ "non-symbol value in exports vector: " ++ show ast)
+                    let resultEnv = M.filterWithKey (\k _ -> L.elem k exportSyms) evaledRawEnv
+                    return resultEnv
+                Just ast -> throwL (astPos ast) $ "exports symbol set to non-symbol value: " ++ show ast
+                Nothing -> throwL (astPos importAst) $ "no exports vector defined in file: " ++ path
+
+            let nameMangled = M.mapKeys (\k -> qualifier ++ ":" ++ k) exportedEnv
+            return $ (M.union env nameMangled, importAst { astNode = ASTUnit })
         [AST { astNode = ASTString path }] -> do
-            (importedEnv, _) <- runScriptFile builtinEnv path
-            return (M.union env importedEnv, importAst { astNode = ASTUnit })
+            (evaledRawEnv, _) <- runScriptFile builtinEnv path
+            let exportsVecASTM = M.lookup "exports" evaledRawEnv
+            exportedEnv <- case exportsVecASTM of
+                Just (AST { astNode = ASTVector exportsVec }) -> do
+                    exportSyms <- exportsVec $>
+                        mapM (\case AST { astNode = ASTSymbol sym } -> return sym
+                                    ast -> throwL (astPos ast) $ "non-symbol value in exports vector: " ++ show ast)
+                    let resultEnv = M.filterWithKey (\k _ -> L.elem k exportSyms) evaledRawEnv
+                    return resultEnv
+                Just ast -> throwL (astPos ast) $ "exports symbol set to non-symbol value: " ++ show ast
+                Nothing -> throwL (astPos importAst) $ "no exports vector defined in file: " ++ path
+
+            return $ (M.union env exportedEnv, importAst { astNode = ASTUnit })
         _ -> throwL (astPos importAst) $ "invalid arguments passed to import!: " ++ show args
 
 evaluateUserFunction :: Depth -> Env -> [AST] -> LContext (Env, AST)
diff --git a/src/Utils.hs b/src/Utils.hs
index 2a2f607..1e9afc5 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -18,7 +18,8 @@ data Config = Config {
     configVerboseMode :: Bool,
     configShowHelp :: Bool,
     configPrintEvaled :: Bool,
-    configPrintCallStack :: Bool
+    configPrintCallStack :: Bool,
+    configUseREPL :: Bool
 }
 
 type LContext a = ReaderT Config (ExceptT LException IO) a
diff --git a/stdlib/common.lisp b/stdlib/common.lisp
new file mode 100644
index 0000000..2db5d62
--- /dev/null
+++ b/stdlib/common.lisp
@@ -0,0 +1,86 @@
+(let! compose (\[f g]
+    (\[x] (f (g x)))))
+
+(let! id (\[a] a))
+
+(let! mod (\[n k]
+    (- n (* k (/ n k)))))
+
+(let! not (\[b]
+    (match b
+        true false
+        false true)))
+
+(let! is-even (\[n]
+    (match (mod n 2)
+        0 true
+        1 false)))
+
+(let! is-odd (compose not is-even))
+
+;; map :: (a -> b) -> [a] -> [b]
+(let! map (\[f lst]
+    (match lst
+        []
+            []
+        otherwise
+            (prepend (f (head lst)) (map f (tail lst))))))
+
+(map (+ 1) [1 2 3])
+
+;; foldr :: (a -> b -> b) -> b -> [a] -> b
+(let! foldr (\[f accumulator lst]
+    (match lst
+        []
+            accumulator
+        otherwise
+            (f (head lst) (foldr f accumulator (tail lst))))))
+
+;; filter :: (a -> Bool) -> [a] -> [a]
+(let! filter (\[pred lst]
+    (match lst
+        [] []
+        otherwise (match (pred (head lst))
+            true
+                (prepend (head lst) (filter pred (tail lst)))
+            false
+                (filter pred (tail lst))))))
+
+(let! fibo (\[n]
+    (let! lazy fibo-1 (fibo (- n 1)))
+    (let! lazy fibo-2 (fibo (- n 2)))
+    (match n
+        0  0
+        1  1
+        _  (+ fibo-1 fibo-2))))
+
+(let! reverse_ (\[v a]
+    (let! lazy x (head v))
+    (let! lazy xs (tail v))
+    (let! lazy xa (prepend x a))
+    (match v
+        [] a
+        _  (reverse_ xs xa))))
+
+(let! reverse (\[v]
+    (reverse_ v [])))
+
+(let! flow (\[fs] (foldr compose id (reverse fs))))
+(let! pipe (\[x fs] ((flow fs) x)))
+
+(let! lazy exports [
+    compose
+    id
+    mod
+    not
+    is-even
+    is-odd
+    map
+    foldr
+    filter
+    fibo
+    reverse_
+    reverse
+    flow
+    pipe
+])
diff --git a/examples/maybe.lisp b/stdlib/maybe.lisp
index 7cabfea..0bc7ac4 100644
--- a/examples/maybe.lisp
+++ b/stdlib/maybe.lisp
@@ -50,7 +50,7 @@
 ;;     (nothing)
 ;;         (print-line! "found nothing!"))
 
-(let! exports [
+(let! lazy exports [
     just
     nothing
     unpack-just