diff options
| -rw-r--r-- | lore/Language/Bs/Eval.hs | 27 | ||||
| -rw-r--r-- | lore/Language/Bs/Primitives.hs | 12 |
2 files changed, 11 insertions, 28 deletions
diff --git a/lore/Language/Bs/Eval.hs b/lore/Language/Bs/Eval.hs index a3232bc..290170b 100644 --- a/lore/Language/Bs/Eval.hs +++ b/lore/Language/Bs/Eval.hs @@ -26,7 +26,6 @@ import Language.Bs.Parser import Language.Bs.Primitives import Protolude import System.Directory -import Text.Parsec funcEnv :: Map.Map T.Text Expr funcEnv = Map.fromList $ primEnv @@ -75,33 +74,17 @@ fileToEvalForm filePath input = either (throw . ParseError . show ) evalBody $ runParseTest :: T.Text -> T.Text -- for view AST runParseTest input = either (T.pack . show) (T.pack . show) $ readExpr input -sTDLIB :: FilePath -sTDLIB = "lore/core.scm" - -endOfList :: Expr -> Expr -> Expr -endOfList (List x) expr = List $ x ++ [expr] -endOfList n _ = throw $ TypeMismatch "failure to get variable: " n - -parseWithLib :: T.Text -> T.Text -> Either ParseError Expr -parseWithLib std inp = do - stdlib <- readExprFile sTDLIB std - expr <- readExpr inp - return $ endOfList stdlib expr - - getFileContents :: FilePath -> IO T.Text getFileContents fname = do exists <- doesFileExist fname if exists then TIO.readFile fname else return "File does not exist." -textToEvalForm :: T.Text -> T.Text -> Eval Expr -textToEvalForm std input = either (throw . ParseError . show ) evalBody - $ parseWithLib std input +textToEvalForm :: T.Text -> Eval Expr +textToEvalForm input = either (throw . ParseError . show ) evalBody $ readExpr input evalText :: T.Text -> IO () --REPL evalText textExpr = do - stdlib <- getFileContents sTDLIB - res <- runASTinEnv basicEnv $ textToEvalForm stdlib textExpr + res <- runASTinEnv basicEnv $ textToEvalForm textExpr print res getVar :: Expr -> Eval Expr @@ -135,9 +118,8 @@ applyFunc expr params args = bindArgsEval params args expr bindArgsEval :: [Expr] -> [Expr] -> Expr -> Eval Expr bindArgsEval params args expr = do Env{..} <- ask - let newVars = zipWith (\a b -> (extractVar a,b)) params args - let (newEnv, newFenv) = Map.partition (not . isFunc) $ Map.fromList newVars + let (newEnv, newFenv) = Map.partition (not . isFunc) $ Map.fromList newVars local (const $ Env (newEnv <> env) (newFenv <> fenv)) $ eval expr isFunc :: Expr -> Bool @@ -150,6 +132,7 @@ eval (List [Atom "dumpEnv", x]) = do liftIO $ print $ toList env liftIO $ print $ toList fenv eval x + eval (Numb i) = return $ Numb i eval (Tape s) = return $ Tape s eval (Bool b) = return $ Bool b diff --git a/lore/Language/Bs/Primitives.hs b/lore/Language/Bs/Primitives.hs index 6042b82..c074c59 100644 --- a/lore/Language/Bs/Primitives.hs +++ b/lore/Language/Bs/Primitives.hs @@ -8,7 +8,7 @@ -- over time. module Language.Bs.Primitives where -import Control.Exception hiding (handle) +import Control.Exception import Control.Monad.Except import Data.Text as T import Data.Text.IO as TIO @@ -87,10 +87,10 @@ wSlurp (Tape txt) = liftIO $ openURL txt wSlurp val = throw $ TypeMismatch "wSlurp expects a string, instead got: " val readTextFile :: T.Text -> Handle -> IO Expr -readTextFile fileName handle = do +readTextFile fileName h = do exists <- doesFileExist $ T.unpack fileName if exists - then (TIO.hGetContents handle) >>= (return . Tape) + then (TIO.hGetContents h) >>= (return . Tape) else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName] put_ :: Expr -> Expr -> Eval Expr @@ -103,10 +103,10 @@ wFilePut fileName msg = withFile (T.unpack fileName) WriteMode go where go = putTextFile fileName msg putTextFile :: T.Text -> T.Text -> Handle -> IO Expr -putTextFile fileName msg handle = do - canWrite <- hIsWritable handle +putTextFile fileName msg h = do + canWrite <- hIsWritable h if canWrite - then (TIO.hPutStr handle msg) >> (return $ Tape msg) + then (TIO.hPutStr h msg) >> (return $ Tape msg) else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName] binopFold :: Binary -> Expr -> [Expr] -> Eval Expr |