summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-03-27 23:33:08 -0700
committerBen Sima <ben@bsima.me>2019-03-27 23:33:08 -0700
commit104f6e2921d0f0969cd33afbbc34b5f3127edbb4 (patch)
tree2e24a025ea0c223b6c0558fdffb98dcd6755e929
parent794b248d0afb9ae7eae1bc0d8f6498a903e02e23 (diff)
bs: remove stdlib and cleanup
-rw-r--r--lore/Language/Bs/Eval.hs27
-rw-r--r--lore/Language/Bs/Primitives.hs12
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