diff options
| -rw-r--r-- | app/Main.hs | 2 | ||||
| -rw-r--r-- | examples/import.lisp | 3 | ||||
| -rw-r--r-- | examples/maybe.lisp | 44 | ||||
| -rw-r--r-- | lang.cabal | 3 | ||||
| -rw-r--r-- | src/Interpreter.hs (renamed from src/Evaluator.hs) | 62 | ||||
| -rw-r--r-- | src/Lib.hs | 43 |
6 files changed, 85 insertions, 72 deletions
diff --git a/app/Main.hs b/app/Main.hs index d8fcb61..c71fd2f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,7 +4,7 @@ import Control.Monad.Except import System.Console.Haskeline import Utils import Builtins -import Lib +import Interpreter parseArgs :: Config -> [String] -> Config parseArgs config args = diff --git a/examples/import.lisp b/examples/import.lisp new file mode 100644 index 0000000..d302562 --- /dev/null +++ b/examples/import.lisp @@ -0,0 +1,3 @@ +(import! M "examples/maybe.lisp") + +(print! (fmt "{0}\n" [(M:just 666)])) diff --git a/examples/maybe.lisp b/examples/maybe.lisp index dab7bf8..7cabfea 100644 --- a/examples/maybe.lisp +++ b/examples/maybe.lisp @@ -31,30 +31,30 @@ ; TESTING -(let! print-line! (\[s] - (print! (concat s "\n")))) +;; (let! print-line! (\[s] +;; (print! (concat s "\n")))) -(let! a (just 10)) -(let! b (nothing)) +;; (let! a (just 10)) +;; (let! b (nothing)) -(map (+ 5) a) -(map (+ 5) b) +;; (map (+ 5) a) +;; (map (+ 5) b) -(and-then (\[n] (just (+ n 5))) a) -(and-then (\[n] (just (+ n 5))) b) +;; (and-then (\[n] (just (+ n 5))) a) +;; (and-then (\[n] (just (+ n 5))) b) -(let! m (just 10)) -(match m - (just _) - (print-line! (fmt "found just {0}!" [(unpack-just m)])) - (nothing) - (print-line! "found nothing!")) +;; (let! m (just 10)) +;; (match m +;; (just _) +;; (print-line! (fmt "found just {0}!" [(unpack-just m)])) +;; (nothing) +;; (print-line! "found nothing!")) -;; (let! exports [ -;; just -;; nothing -;; unpack-just -;; kind -;; map -;; and-then -;; ]) +(let! exports [ + just + nothing + unpack-just + kind + map + and-then +]) @@ -26,8 +26,7 @@ source-repository head library exposed-modules: Builtins - Evaluator - Lib + Interpreter Parser Tokenizer Utils diff --git a/src/Evaluator.hs b/src/Interpreter.hs index b7b792b..33e36ea 100644 --- a/src/Evaluator.hs +++ b/src/Interpreter.hs @@ -1,15 +1,19 @@ {-# LANGUAGE LambdaCase #-} -module Evaluator ( - evaluate, +module Interpreter ( + runInlineScript, + runScriptFile ) where import qualified Data.Map as M import qualified Data.List as L import Data.Function ( on ) import Control.Monad.Reader -import Control.Monad.Except ( catchError ) +import Control.Monad.Except import Utils -- import Debug.Trace +import Builtins +import Tokenizer ( tokenize ) +import Parser ( parse ) type Depth = Int @@ -171,7 +175,7 @@ evaluateLet d env asts = do evaluateEnv :: Depth -> Env -> [AST] -> LContext (Env, AST) evaluateEnv d env asts = do let envAst = head asts - when (d > 1) $ throwL (astPos envAst) $ "env! can only be called on the top level or in a function definition" + when (d > 1) $ throwL (astPos envAst) $ "env! can only be called on the top level" let pairs = M.assocs env let longestKey = L.maximumBy (compare `on` (length . fst)) pairs $> fst let pad s = s ++ take (length longestKey + 4 - length s) (L.repeat ' ') @@ -179,6 +183,22 @@ evaluateEnv d env asts = do liftIO $ mapM_ putStrLn rows return (env, envAst { astNode = ASTUnit }) +evaluateImport :: Depth -> Env -> [AST] -> LContext (Env, AST) +evaluateImport d env asts = do + let importAst = head asts + args = tail asts + when (d > 1) $ throwL (astPos importAst) $ "import! can only be called on the top level" + + 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 }) + [AST { astNode = ASTString path }] -> do + (importedEnv, _) <- runScriptFile builtinEnv path + return (M.union env importedEnv, importAst { astNode = ASTUnit }) + _ -> throwL (astPos importAst) $ "invalid arguments passed to import!: " ++ show args + evaluateUserFunction :: Depth -> Env -> [AST] -> LContext (Env, AST) evaluateUserFunction d env children = do let fnAst = head children @@ -215,6 +235,8 @@ evaluate d env AST { astNode = fnc@(ASTFunctionCall args@(x:_)) } = evaluateLet (d + 1) env args ASTSymbol "env!" -> evaluateEnv (d + 1) env args + ASTSymbol "import!" -> + evaluateImport (d + 1) env args _ -> evaluateUserFunction (d + 1) env args evaluate _ env ast@AST { astNode = (ASTSymbol _) } = @@ -225,3 +247,35 @@ evaluate d env ast@AST { astNode = (ASTVector vec) } = return $ (env, ast { astNode = ASTVector vec' }) evaluate _ env other = return (env, other) + +-- LIB + +runScriptFile :: Env -> String -> LContext (Env, [AST]) +runScriptFile env fileName = do + src <- liftIO $ readFile fileName + runInlineScript fileName env src + +runInlineScript :: String -> Env -> String -> LContext (Env, [AST]) +runInlineScript fileName env src = do + tokenized <- tokenize fileName src + config <- ask + when (configVerboseMode config) $ liftIO $ putStrLn $ "tokenized:\t\t" ++ show tokenized + parsed <- parse tokenized + + when (configVerboseMode config) $ do + let output = "parsed:\t\t\t" ++ (map show parsed $> L.intercalate "\n\t\t\t") + liftIO $ putStrLn output + + (newEnv, evaluated) <- foldEvaluate env parsed + + when (configPrintEvaled config) $ do + liftIO $ mapM_ putStrLn (map show evaluated) + + return (newEnv, evaluated) + where + foldEvaluate :: Env -> [AST] -> LContext (Env, [AST]) + foldEvaluate accEnv [] = return (accEnv, []) + foldEvaluate accEnv (ast:rest) = do + (newAccEnv, newAst) <- evaluate 0 accEnv ast + (retEnv, restEvaled) <- foldEvaluate newAccEnv rest + return $ (retEnv, newAst : restEvaled) diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index 8b26a35..0000000 --- a/src/Lib.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -module Lib ( - runScriptFile, - runInlineScript, -) where - -import qualified Data.List as L -import Control.Monad.Except -import Control.Monad.Reader -import Utils -import Tokenizer ( tokenize ) -import Parser ( parse ) -import Evaluator ( evaluate ) - -runScriptFile :: Env -> String -> LContext (Env, [AST]) -runScriptFile env fileName = do - src <- liftIO $ readFile fileName - runInlineScript fileName env src - -runInlineScript :: String -> Env -> String -> LContext (Env, [AST]) -runInlineScript fileName env src = do - tokenized <- tokenize fileName src - config <- ask - when (configVerboseMode config) $ liftIO $ putStrLn $ "tokenized:\t\t" ++ show tokenized - parsed <- parse tokenized - - when (configVerboseMode config) $ do - let output = "parsed:\t\t\t" ++ (map show parsed $> L.intercalate "\n\t\t\t") - liftIO $ putStrLn output - - (newEnv, evaluated) <- foldEvaluate env parsed - - when (configPrintEvaled config) $ do - liftIO $ mapM_ putStrLn (map show evaluated) - - return (newEnv, evaluated) - where - foldEvaluate :: Env -> [AST] -> LContext (Env, [AST]) - foldEvaluate accEnv [] = return (accEnv, []) - foldEvaluate accEnv (ast:rest) = do - (newAccEnv, newAst) <- evaluate 0 accEnv ast - (retEnv, restEvaled) <- foldEvaluate newAccEnv rest - return $ (retEnv, newAst : restEvaled) |